Sauvegarder un filtre complexe pour l'enlever et le remettre

[katuvu]

Bonjour,

Après recherche sur ce forum et sur d'autres, je n'ai pas trouvé de solution à mon problème. J'ouvre donc une nouvelle discussion.

Je cherche à sauvegarder un filtre, avec une macro VBA, pour pouvoir le réappliquer ensuite.
Concrètement: un onglet excel est filtré (sur une ou plusieurs colonnes)
1/ Je sauvegarde les filtres existants (fonction sauve_filtre())
2/ je supprime ces filtres pour faire quoi que ce soit sur l'onglet (appliquer d'autres macros par exemple)
3/ je réapplique les filtres sauvegardés (fonction restaure_filtre())

J'avais créé une macro, qui fonctionnait très bien sur Excel 2003. Mais mon entreprise est passée à Excel 2007 et ça ne marche plus à chaque fois: les critères des filtres sont beaucoup plus complexes (on peut faire des sélections multiples).

Ci dessous, voici mon code (à l'époque, je m'étais basé sur un code trouvé sur F1: "Autofilter"). Pourriez-vous m'indiquer comment je pourrais l'améliorer pour qu'il fonctionne à tous les coups (quels que soient les critères sélectionnés dans les filtres) ?
Merci d'avance,

Thibault.

-----------------------------------------------------------

Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim Monfiltre As Variant
Dim Monfiltre2 As Variant

Sub sauve_filtre()
Set w = ActiveWorkbook.ActiveSheet
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator = 1 Or .Operator = 2 Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
w.AutoFilterMode = False
End Sub



Sub restaure_filtre()

Set w = ActiveSheet
w.AutoFilterMode = False
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
Monfiltre = filterArray(col, 1)
If filterArray(col, 2) Then
Monfiltre2 = filterArray(col, 3)
w.Range(currentFiltRange).AutoFilter field:=col, Criteria1:=Monfiltre, Operator:=filterArray(col, 2), Criteria2:=Monfiltre2
Else
w.Range(currentFiltRange).AutoFilter field:=col, Criteria1:=Monfiltre
End If
End If
Next

End Sub

 

[mromain]

Re : Sauvegarder un filtre complexe pour l'enlever et le remettre

Bonjour katuvu et bienvenue sur le forum,


Voici ton code modifiée. Il a l'air de fonctionner lorsqu'on filtre sur plusieurs choix.
Par contre, n'étant vraiment pas un adepte des filtres, je ne les utilises jamais. Je ne suis donc pas certain que ça fonctionnera sur tous les types de filtres (c'est vrai que c'est plus complexe depuis 2007).

Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim Monfiltre As Variant
Dim Monfiltre2 As Variant
Const delim As String = "</:\>"

Sub sauve_filtre()
Dim f As Long, multiSelect As String, iItem As Long
    Set w = ActiveWorkbook.ActiveSheet
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 4)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Operator
                        If .Operator = 7 Then
                            multiSelect = ""
                            For iItem = LBound(.Criteria1) To UBound(.Criteria1)
                                multiSelect = multiSelect & IIf(multiSelect = "", "", delim) & .Criteria1(iItem)
                            Next iItem
                            filterArray(f, 2) = multiSelect
                        Else
                            filterArray(f, 2) = .Criteria1
                            If .Operator = 1 Or .Operator = 2 Then
                                filterArray(f, 3) = .Operator
                                filterArray(f, 4) = .Criteria2
                            End If
                        End If
                    End If
                End With
            Next f
        End With
    End With
    w.AutoFilterMode = False
End Sub



Sub restaure_filtre()
Dim col As Long
    Set w = ActiveSheet
    w.AutoFilterMode = False
    For col = 1 To UBound(filterArray(), 2)
        If Not IsEmpty(filterArray(col, 2)) Then
            If filterArray(col, 1) = 7 Then
                Monfiltre = Split(filterArray(col, 2), delim)
                w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre, Operator:=xlFilterValues
            Else
                Monfiltre = filterArray(col, 2)
                If filterArray(col, 3) Then
                    Monfiltre2 = filterArray(col, 4)
                    w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre, Operator:=filterArray(col, 3), Criteria2:=Monfiltre2
                Else
                    w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre
                End If
            End If
        End If
    Next
End Sub

a+

 

[katuvu]

Re : Sauvegarder un filtre complexe pour l'enlever et le remettre

Merci pour ta réponse rapide, mromain.
Je regarde ça et je te tiens au courant.

A+

 

[katuvu]

Re : Sauvegarder un filtre complexe pour l'enlever et le remettre

Mromain, ton code n'a pas fonctionné immédiatement, c'est pourquoi je m'y suis replongé. J'y ai passé du temps, trop sans doute... Pour arriver à quelque chose de très similaire à ce que tu avais fait.

Au final je ne sais pas ce que j'ai corrigé (peut-être juste un nombre quelque part), mais à mon avis 3 fois rien.... et voici donc le code qui fonctionne:

moncode----------------------------------
Dim w As Worksheet
Dim filterArray()
Dim multiselection()
Dim currentFiltRange As String
Dim Monfiltre As Variant
Dim Monfiltre2 As Variant
Const delim As String = "</:\>"
-----------------------------------

Sub sauve_filtre()
Dim f As Long
Dim col As Integer
Dim iItem As Long
    Set w = ActiveWorkbook.ActiveSheet
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            col = .Count
            ReDim filterArray(1 To col, 1 To 4)
            For f = 1 To col
                With .Item(f)
                    filterArray(f, 1) = .On
                    If .On Then
                        filterArray(f, 2) = .Operator
                        If .Operator = 7 Then
                            multiSelect = ""
                            For iItem = LBound(.Criteria1) To UBound(.Criteria1)
                                multiSelect = multiSelect & IIf(multiSelect = "", "", delim) & .Criteria1(iItem)
                            Next iItem
                            filterArray(f, 3) = multiSelect
                        Else
                            filterArray(f, 3) = .Criteria1
                            If .Operator = 1 Or .Operator = 2 Then
                                filterArray(f, 4) = .Criteria2
                            End If
                        End If
                    End If
                End With
            Next f
        End With
    End With
    w.AutoFilterMode = False
   
End Sub


-----------------------------------

Sub restaure_filtre()
Dim col As Integer
    Set w = ActiveSheet
    w.AutoFilterMode = False
    For col = 1 To UBound(filterArray(), 1)
        'On vérifie s'il y a un filtre pour chaque colonne
        If filterArray(col, 1) = True Then
            'Il y a un filtre. Est-ce un multi-selection?
            If filterArray(col, 2) = 7 Then
                Monfiltre = Split(filterArray(col, 3), delim)
                w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre, Operator:=xlFilterValues
            Else
                'le filtre est "classique"
                Monfiltre = filterArray(col, 3)
                If filterArray(col, 2) = 1 Or filterArray(col, 2) = 2 Then
                    Monfiltre2 = filterArray(col, 4)
                    w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre, Operator:=filterArray(col, 2), Criteria2:=Monfiltre2
                Else
                    w.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Monfiltre
                End If
            End If
        End If
    Next
End Sub
------------------------------------

Un grand merci à toi, Mromain.

Pour info pour les autres: ce code permet aussi d'appliquer sur d'autres onglets un filtre élaboré déjà existant dans un onglet.
Si ça peut vous servir....

 

[mromain]

Re : Sauvegarder un filtre complexe pour l'enlever et le remettre

Re,

Merci pour le retour

a+