1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
| 'Cette fonction permet de retourner le filtre appliqué à feuille appelante
'Origine du code http://www.developpez.net/forums/d1299032/logiciels/microsoft-office/excel/macros-vba-excel/recuperer-filtre-automatique-vba/
'Ajout des déclarations de variables GM 11/10/2016
'Capacité à travailler avec 1 ListObject
Function FiltreTotal()
Dim Feuille As String
Dim C As Long
Dim Chaine As String
Dim NbColFiltre As Long
Dim FeuilCour As Worksheet
Dim ZoneFiltree As Range
Application.Volatile
Feuille = Application.Caller.Parent.Name
Set FeuilCour = Application.Caller.Parent
Chaine = ""
If FeuilCour.ListObjects.Count <> 0 Then
NbColFiltre = FeuilCour.ListObjects(1).ListColumns.Count
Set ZoneFiltree = FeuilCour.ListObjects(1).AutoFilter.Range
Else
NbColFiltre = Sheets(Feuille).Range("_FilterDataBase").Columns.Count
Set ZoneFiltree = Sheets(Feuille).Range("_FilterDataBase")
End If
For C = 1 To NbColFiltre
If FiltreActuelNo(C) <> "" Then
If IsDate(ZoneFiltree.Cells(2, C)) Then
Chaine = Chaine & ZoneFiltree.Cells(1, C) & FiltreActuelNo(C, "D") & " "
Else
Chaine = Chaine & ZoneFiltree.Cells(1, C).value & FiltreActuelNo(C) & " "
End If
End If
Next C
If Chaine = "" Then Chaine = "Tout"
FiltreTotal = Chaine
End Function
'Cette fonction permet de retourner le filtre appliqué à la colonne numéro col de la feuille appelante
'Origine du code http://www.developpez.net/forums/d1299032/logiciels/microsoft-office/excel/macros-vba-excel/recuperer-filtre-automatique-vba/
'Ajout des déclarations de variables GM 11/10/2016
'Capacité à travailler avec 1 ListObject
Function FiltreActuelNo(col As Long, Optional typeCol As String)
Dim Feuille As String
Dim temp As Variant, temp2 As Variant
Dim o As String, n As String, oper As String
Dim FeuilCour As Worksheet
Dim FiltreCour As AutoFilter
Application.Volatile
Feuille = Application.Caller.Parent.Name
Set FeuilCour = Application.Caller.Parent
Set FiltreCour = Nothing
If FeuilCour.ListObjects.Count <> 0 Then
Set FiltreCour = FeuilCour.ListObjects(1).AutoFilter
ElseIf Sheets(Feuille).FilterMode Then
Set FiltreCour = Sheets(Feuille).AutoFilter
End If
If Not FiltreCour Is Nothing Then
If FiltreCour.Filters.Item(col).On Then
temp = FiltreCour.Filters.Item(col).Criteria1
If Left(temp, 2) = ">=" Or Left(temp, 2) = "<=" Then
o = Left(temp, 2): n = Mid(temp, 3)
Else
If Left(temp, 1) = "=" Or Left(temp, 1) = ">" Or Left(temp, 1) = "<" Then
o = Left(temp, 1): n = Mid(temp, 2)
Else
n = temp
End If
End If
If typeCol = "D" Then n = Format(n, "dd/mm/yy")
temp = o & n
'---
If FiltreCour.Filters.Item(col).Operator Then
oper = IIf(FiltreCour.Filters.Item(col).Operator = 1, " ET ", " OU ")
On Error Resume Next
Err = 0
temp2 = FiltreCour.Filters.Item(col).Criteria2
If Err = 0 Then
If Left(temp2, 2) = ">=" Or Left(temp2, 2) = "<=" Then
o = Left(temp2, 2): n = Mid(temp2, 3)
Else
If Left(temp2, 1) = "=" Or Left(temp2, 1) = ">" Or Left(temp2, 1) = "<" _
Then o = Left(temp2, 1): n = Mid(temp2, 2)
End If
If typeCol = "D" Then n = Format(n, "dd/mm/yy")
temp2 = o & n
Else
oper = ""
End If
End If
FiltreActuelNo = temp & oper & temp2
Else
FiltreActuelNo = ""
End If
Else
FiltreActuelNo = ""
End If
End Function |
