Discussion :

[saigon]

Bonjour,

j'aimerais récupérer les valeurs d'un filtre automatique en vba.

j'y suis arrivé pour deux critères selectionnés

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub nombreCritere()
    Debug.Print ActiveSheet.AutoFilter.Filters(1).Criteria1
    Debug.Print ActiveSheet.AutoFilter.Filters(1).Criteria2
End Sub

mais impossible de récupérer dès lors que j'ai plus de 2 filtres...

une idée ?

PS : si un modo passe par là qu'il mette mon post dans la section VBA...me suis trompé merci.

Merci.
Sai

[Daniel.C]

Bonjour,

Si tu parles de filtres obtenus en cochant des cases de sélection, il semblerait que ce soit impossible. La meilleure réponse que j'aie obtenue (Rory Archibald) :

It does appear impossible to
return the filter values directly (they are stored in the XML of course)

Regards,
Rory

[saigon]

arf...j'étais persuadé qu'on pouvait...

merci pour ton retour !

[Daniel.C]

C'est absolument anormal qu'on ne puisse pas les récupérer par VBA alors qu'on peut les mettre par VBA, je suis bien d'accord.

[saigon]

bon je crois avoir trouvé...c'est bizarre

en gros lorsque le nombre de filtre coché est strictement supérieur à 2 on peut boucler sur la propriété Criteria1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Sub filterList()
  For Each n In ActiveSheet.AutoFilter.Filters(1).Criteria1
    Debug.Print n
  Next
End Sub

je viens de tester ça marche plutôt bien...si ça peut servir à quelqu'un

Sai

[Daniel.C]

Exact, sauf pour les filtres sur les dates ou les heures.

[Invité]

Bonjour,

Cf fonction filtretotal()

Code :

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
 
Function FiltreTotal()
   Application.Volatile
   feuille = Application.Caller.Parent.Name
   chaine = ""
   For c = 1 To Sheets(feuille).Range("_FilterDataBase").Columns.Count
     If FiltreActuelNo(c) <> "" Then
       If IsDate(Sheets(feuille).Range("_FilterDataBase").Cells(2, c)) Then
         chaine = chaine & Sheets(feuille).Range("_FilterDataBase").Cells(1, c) & FiltreActuelNo(c, "D") & " "
       Else
         chaine = chaine & Sheets(feuille).Range("_FilterDataBase").Cells(1, c).Value & FiltreActuelNo(c) & " "
       End If
     End If
   Next c
   If chaine = "" Then chaine = "Tout"
   FiltreTotal = chaine
End Function
 
Function FiltreActuelNo(col, Optional typeCol As String)
 feuille = Application.Caller.Parent.Name
 Application.Volatile
 If Sheets(feuille).FilterMode Then
    If Sheets(feuille).AutoFilter.Filters.Item(col).On Then
      temp = Sheets(feuille).AutoFilter.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 Sheets(feuille).AutoFilter.Filters.Item(col).Operator Then
          oper = IIf(Sheets(feuille).AutoFilter.Filters.Item(col).Operator = 1, " ET ", " OU ")
          On Error Resume Next
          Err = 0
          temp2 = Sheets(feuille).AutoFilter.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

JB

[Invité]

Bonjour

Salut Jacques

Tu pourrais détailler ta fonction personnalisée pour les membres du forum qui ne peuvent ou ne veulent récupérer des pièces jointes.

Merci

Philippe

[Daniel.C]

Bonjour Jacques,

Quand tu as une colonne avec des dates et que les éléments du filtre sont sélectés avec des cases à cocher (filtre chronologique, à partir de XL2007), la ligne :

temp = Sheets(feuille).AutoFilter.Filters.Item(col).Criteria1

plante (erreur 1004). Quand tu exécutes la ligne :

Set Var = ActiveSheet.AutoFilter.Filters.Item(1)

et que tu regardes la variable dans la fenêtre des variables locales, en face de "Criteria1", tu vois "erreur définie par l'application ou par l'objet".

[Didier Gonard]

bonjour,

Explication possible :

Quand tu emploies des filtres à cocher chronologiques sous 2007-2010, tu passes systématiquement en Criteria2 tout seul (il n’y a pas de 1) lié à la valeur xlFilterValues de l’opérateur XlAutoFilterOperator (6 valeurs en 2003, 11 ensuite) renvoyé par la propriété Operator de l’objet Filter.

Cette valeur exploite un array, ils ont dû bricoler ça pour conserver la compatibilité, donc officiellement que 2 possibilités, mais la deuxième pouvant être sous forme d’array, ça permet la panoplie de choix que tolère le système de coches.

Donc via cette façon d’opérer, tu n’auras pas de Criteria1 et le code ne risque pas de le trouver ?

cordialement,

Didier

[Daniel.C]

Bonjour Ormonth,

On n'a pas non plus accès à Criteria2.

[Invité]

Bonjour,

J'ai pu adapter les choix multiples pour les chaînes (récupérées dans un tableau dans critère1)
Logiquement, les dates multiples devraient être récupérées dans un tableau dans critère2 mais je n'y parviens pas



JB

[Didier Gonard]

Bonjour,

@ Daniel & Jacques, avec les filtres à cocher chronologiques par défaut, on passe direct en Criteria2 et je n'arrive pas non plus à y avoir accès.

Je pense que ça vient du fait qu’ils ont construit une usine à gaz (super pratique par contre) à ce niveau.

En effet le comportement de ces filtres est à la base conditionné par l’option Grouper les Dates dans le menu Filtre automatique du Groupe Afficher les options pour ce classeur, celle-ci étant activée par défaut.

Si on la désactive, manuellement ou par code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWindow.AutoFilterDateGrouping = False  ' desactive l'option grouper dates du filtre auto

...on a du coup une liste de coches de toutes les occurrences dates et si on fait un filtre, on obtient un comportement classique avec un Array sous Criteria1 du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ActiveSheet.Range("$A$1:$D$21").AutoFilter Field:=3, Criteria1:=Array("14/09/2004 14:12:16", "17/01/2013 11:26:45", _
"19/12/2008 18:04:07", "24/07/2009 14:27:32"), Operator:=xlFilterValues

qu’on peut exploiter, de façon normale, comme dans le code ci-dessous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Gogo()
Dim elt As Variant
 
For Each elt In ActiveSheet.AutoFilter.Filters.Item(3).Criteria1
    Debug.Print elt
Next elt
End Sub

Par contre en mode par défaut, on obtient, avec l’enregistreur, un code plus bizarre, qui fonctionne bien si on le lance et nous donne donc la méthode à employer en construction si besoin, genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub EnregistreurDG()
 
ActiveSheet.Range("$A$1:$D$21").AutoFilter Field:=3, Operator:=xlFilterValues, _
Criteria2:=Array(2, "1/17/2013", 1, "5/24/2012", 5, "9/22/2011 15:6:12", 3, "12/19/2008 18:22:48", _
0, "7/16/2007", 4, "9/14/2004 14:12:16")
 
End Sub

D’autant plus spécifique que si on le lance avec l’option de groupement de dates désactivées, ça marche sans souci et sans la réactiver (preuve qu’il reconnaît bien ses petits…)

On peut constater que dans ce code :

Les mois et les dates sont toujours inversés sans souci de cohérence puisque textuellement on aurait des dates du genre "5/24/2012", ce qui sous-entendrait un mois « 24 » dans l’année. On peut donc considérer que dans son traitement sous-jacent, il traite des chaînes de texte qu’il manipule selon les pays pour retrouver ses petits en dates au final.

L’array obtenu associe un item de plus à chaque ensemble de dates, mais impossible d’avoir accès à sa structure car on ne peut avoir accès à la propriété Criteria2..

En désespoir de cause, je suis allé voir dans le code XML de la feuille et on trouve ceci :

<autoFilter ref="A1-D21"><filterColumn colId="2"><filters><dateGroupItem year="2013" month="1" day="17" dateTimeGrouping="day"/><dateGroupItem year="2012" month="5" dateTimeGrouping="month"/><dateGroupItem year="2011" month="9" day="22" hour="15" minute="6" second="12" dateTimeGrouping="second"/><dateGroupItem year="2008" month="12" day="19" hour="18" dateTimeGrouping="hour"/><dateGroupItem year="2007" dateTimeGrouping="year"/><dateGroupItem year="2004" month="9" day="14" hour="14" minute="12" dateTimeGrouping="minute"/></filters></filterColumn></autoFilter>

Soit classé chrhonologiquement :

<dateGroupItem year="2007" dateTimeGrouping="year"/>

<dateGroupItem year="2012" month="5" dateTimeGrouping="month"/>

<dateGroupItem year="2013" month="1" day="17" dateTimeGrouping="day"/>

<dateGroupItem year="2008" month="12" day="19" hour="18" dateTimeGrouping="hour"/>

<dateGroupItem year="2004" month="9" day="14" hour="14" minute="12" dateTimeGrouping="minute"/>

<dateGroupItem year="2011" month="9" day="22" hour="15" minute="6" second="12" dateTimeGrouping="second"/>

note : "A1-D21" = "A1:D21"

En rapprochant les données de l’Array VBA à ça, on peut en déduire que les Items supplémentaires correspondent à ceci :

0 ans
1 mois
2 jours
3 heures
4 minutes
5 secondes

Donc j’en suis, dans mon approche de solution, à penser qu’il faudra passer en VBA par le XML pour arriver à ses fins.
Donc soit récupérer les infos par String dans le fichier texte, soit importer le fichier XML de la feuille et voir si on peut y récupérer les données qui s’y trouvent selon une forme ou une autre. Le plus simple sera surement la piste texte.

J’en suis là, mais ayant d’autres marrons sur le feu et j’avance à mes moments perdus.

mon fichier test de base est le suivant :
Filtre auto Dates 2010DG-Dates macrosTest.xlsx

ps: pour activer le test que j'ai fait, il suffit d'y coller la macro ci-dessus

cordialement,

Didier

[Daniel.C]

Bonjour Ormonth,

... et la boucle est bouclée :

Citation:
It does appear impossible to
return the filter values directly (they are stored in the XML of course)

Regards,
Rory

[Guy_M]

Bonjour,

Cf fonction filtretotal()

JB

Ce code fonctionne mais ne marche pas systématiquement avec Excel 2010 car dans la fonction "FiltreActuelNo" Sheets(feuille).AutoFilter.Filters.Item(col).Criteria1 ou Sheets(feuille).AutoFilter.Filters.Item(col).Criteria2 peuvent être un tableau donc il faut commencer par les tester avec IsArray(FiltreCour.Filters.Item(col).Criteria1), dans le cas où Criteria1 ou Criteria2 est un tableau (mise à jour, on peut tester à la valeur de .Operator "Operator = xlFilterValues"), puis il faut boucler sur les critère pour appliquer la partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
      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

Je ne vous fournit pas la fonction révisée, car je n'ai fait qu'une adaptation rustique (je ne traite pas le cas des dates).
En espérant que cela sera utile à quelqu'un.
GM