VBA boite de dialogue macro filtre

[Duma]

Bonjour à tous
voila je suis nouveau sur le forum et j'ai grand besoin de votre aide.

Voici ma consigne pour ma macro a faire.
Voilà
1) faire une macro qui va generer une boite de dialogue de tel sorte qu'on puisse :

Choisir le fichier voulu exemple ''Zlam filtre sans macro"
Choisir la feuille voulue exemple Sheet1

Dans cette feuille choisir dans l'entete le mot ' Period' qui sera ma point de reference

Sachant que dans la colonne "Period" j'ai Q1,Q2,Q3,Q4

Ma boite de dialogue doit me permetttre de choisir la periode que je veux pour faire un fitre automatique qui ne prendra en compte que et uniquement la (les) periodes selectionnées (Q1,Q2,ou Q3 ou encore Q4)

Le but etant, meme si par la suite on insert des colonnes (car c'est pas moi qui choisi d'inserer ou pas de nouvelles colonnes ) dans mon fichier cela ne puisse pas casser ma macro.
Apres le filtre j'airai simplement à faire une rechercheV par la suite qui puissse prendre en consideration uniquement les valeurs filtrées. ( pour la suite de mes traveaux)

Avec cette macro dans ces fichiers joints je peux faire les fitres mais au lieu que cela me split toutes les periodes je veux simplement une boite de dialogue ou je pourrais choisir ca periode.

NB: mon veritable probleme c'est que je ne voudrai pas de feuille exterieur. c'est ce que m'exige ma consigne malheureusement pour moi ou heureusement car j'apprendrai de vous.

je compte vraiment sur vous car apres plusieurs tentatives je n'arrive a rien qui me satisfasse.

Merci d'avance !!!

 

[Guest]

Re : VBA boite de dialogue macro filtre

Bonjour,

Même discussion qu'ici:https://www.excel-downloads.com/threads/vba-probleme-serieux-pour-moi.213390/ pour laquelle tu n'as pas obtenu de réponse. visiblement tu n'as changé Que le titre de ta discussion.

Peut-être n'as - tu pas saisi l'esprit du forum, qui est le partage et non la réalisation de macro suivant un cahier des charges développé par le demandeur. Pour cela il y a les professionnels, auxquels nous n'avons pas à faire concurrence.

Sans doute, qu'en commençant tes macros et en disant quelles difficultés tu rencontres dans leur réalisation, en posant une question sur un point précis, tu aurais plus de réponse.

A+

 

[Duma]

Re : VBA boite de dialogue macro filtre

Merci pour ton message.
j'ai ai travaillé sur ma macro mais elle me permet juste de faire des filtres en splittant mes périodes. or c'est pas ce que je veux. je veux le faire avec une boite de dialogue mais je suis pas doué pour ça. des petites macro encore je peux mais ça j'aurai vraiment besoin d'aide

merci

 

[Duma]

Re : VBA boite de dialogue macro filtre

Voici la macro que j'ai fais j'ai un message d'erreur qui de m'affiche meme pas ma boite de dialogue .deja pouvez vous verifier si la macro est juste. je vous vous met en fichier joint mes fichiers.

Sub AP()

'Variables Declaration
Dim Path As String, File As String
Dim Worksheet As Worksheet
Dim Target_Worksheet As String
Dim OK_Worksheet As Boolean, Start As Boolean
Dim Name As Name
Dim FirstLine As Long, LastLine As Long, LastLineTarget As Long
Dim FirstColumn As Long, LastColumn As Long

Target_Worksheet = "Sheet1"
ThisWorkbook.Sheets(Target_Worksheet).Cells.Clear
Path = ThisWorkbook.Path
Start = True

'If unsaved file, then no path => always save the file before executing the macro
If Path <> "" Then
'Filters only on Excel files
File = Dir(Path & "\*.*xls*")
'Only "esthetic" : improves speed and processing appearance (deactivating sreen update)
Application.ScreenUpdating = False

Do While File <> ""
If File <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Path & "\" & File, ReadOnly:=True, UpdateLinks:=False

Application.DisplayAlerts = False

'Test if worksheet exists
OK_Worksheet = False
For Each Worksheet In Workbooks(File).Sheets
If Worksheet.Name = Target_Worksheet Then OK_Worksheet = True: Exit For
Next

'If worksheet OK => copies worksheet content to "AP" file
If OK_Worksheet Then

Worksheet.Unprotect Password:="FCII"
Worksheet.Columns.Ungroup
Worksheet.AutoFilterMode = False

'Sets the range to copy in "AP"
FirstLine = LookforPeriod(Workbooks(File), Target_Worksheet) + 1
If Not Start Then FirstLine = FirstLine + 1
Start = False
LastLine = LookforLastline(Workbooks(File), Target_Worksheet)
FirstColumn = LookforFirstColumn(Workbooks(File), Target_Worksheet)
LastColumn = LookforLastColumn(Workbooks(File), Target_Worksheet)
LastLineTarget = LookforLastline(ThisWorkbook, "Sheet1") + 1

'No copy of the header if not the first file copied
With Workbooks(File).Sheets(Target_Worksheet)
.Range(.Cells(FirstLine, FirstColumn).Address & ":" & .Cells(LastLine, LastColumn).Address).Copy Destination:=ThisWorkbook.Sheets("Actual HC ERC").Range("A" & LastLineTarget)
End With

'Deletes named cells
For Each Name In ThisWorkbook.Names
Name.Delete
Next

Start = False
End If
Worksheet.Protect Password:="FCII"
Workbooks(File).Close False
End If
File = Dir
Loop

'Breaks Links
Dim Link As Variant
For Each Link In ActiveWorkbook.LinkSources
ActiveWorkbook.BreakLink Name:=Link, Type:=1
Next

'Deletes Data/Validation
Sheets("Sheet1").Select
Cells.Validation.Delete

'Deletes Conditional Formatting
Sheets("Sheet1").Select
Cells.FormatConditions.Delete

'Sorts data by Period
Cells.Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"Period"), SortOn:=xlSortOnValues, Order:=xlSelectedperiod, DataOption:= _
xlSortNormal

With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Rows("1:01048576")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Filters
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter

Sheets("Updates").Select

' Re-activates Display Alerts
Application.DisplayAlerts = True

' Re-activates screen update
Application.ScreenUpdating = True
End If

End Sub

Sub Filtre()
Dim J As Long, Nblg As Long
Dim Ws As Worksheet, WsBase As Worksheet, WbBase As Workbook
Dim Tablo()
Dim I As Integer, Indice As Integer
Dim Chemin As String, Fichier As String

Application.ScreenUpdating = False
Set Ws = ActiveSheet
Chemin = ThisWorkbook.Path & "\"
Fichier = "AP sans macro"

If Dir(Chemin & Fichier) = "" Then
MsgBox "Fichier " & Fichier & " introuvable"
Exit Sub
End If
Set WbBase = Workbooks.Open(Chemin & Fichier)
Set WsBase = WbBase.Sheets(1)
If WsBase.FilterMode = True Then WsBase.ShowAllData
Nblg = WsBase.Range("Period" & Rows.Count).End(xlUp).Row

ReDim Tablo(0)
For J = 3 To Nblg
For I = 0 To UBound(Tablo)
If Tablo(I) = WsBase.Range("Period" & J) Then Exit For
Next I
If I > UBound(Tablo) Then
ReDim Preserve Tablo(Indice)
Tablo(Indice) = WsBase.Range("Period" & J)
Indice = Indice + 1
End If
Sheets("Updates").Select

' Re-activates Display Alerts
Application.DisplayAlerts = True

' Re-activates screen update
Application.ScreenUpdating = True
End If

End Sub

Function FeuilleExiste(WkB As Workbook, Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = WkB.Sheets(Nom).Name <> ""
On Error GoTo 0
End Function