Bonjour,

J'ai lu cette discussion.
Citation Envoyé par Invité Voir le message
Cf fonction filtretotal()
(...)

JB
Cette fonction ne fonctionne pas avec les tableaux Excel (ListObjects). Pour mon usage personnel, j'ai fait une petite adaptation pour prendre en compte ce cas là.

Limitations :
Si il y a un tableau, cela ne prend en compte que le premier tableau (ListObject) et donc si une autre zone de la feuille est filtrée, elle est ignorée.
Cette fonction a l'air de mal cohabiter avec Power Query (je dois fait "stop" dans Visual Basic pour reprendre la main dans la feuille de calcul, on peut contourner en supprimant ou en mettant en commentaire la ligne "Application.Volatile", dans ce cas la mise à jour doit être faites à la main.)

En espérant que cela sera utile à quelqu'un.

Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
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

A bientôt
Guy Marty