Filtre de TCD via VBA

Bonjour au forum,

Est-il possible de filtrer des éléments d'un TCD via une macro ?

J'ai testé plusieurs code mais impossible d'en venir à bout... L'enregistreur de macros ne m'aide pas plus que ça non plus malheureusement

Dans le TCD joint, j'aimerais 2 choses :

• Dans le champs "filtre", sélectionner uniquement les éléments "Produit 1" et "Produit 2", s'il existe (c'est possible que soit l'un soit l'autre ne soit pas présent)
• Dans les étiquettes de colonnes, , sélectionner uniquement les éléments "Dépôt 1", "Dépôt 2" et "Dépôt 3", s'il existe (c'est possible que certains ne soient pas présents)

Une autre question bonus : est-il possible d'appliquer un filtre "si date de la cellule = date du jour" ?

Merci d'avance

Re,

J'ai testé ceci, qui me semblait être une bonne piste :

Option Explicit

Sub FilterPivotTable()
Dim pt As PivotTable
Dim pi As PivotItem

Application.ScreenUpdating = False

    Set pt = Sheets("TCD_Jour").PivotTables("TCD2")

        With pt.PivotFields("Produit")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In pt.PivotFields("Produit").PivotItems
                'On Error Resume Next
                If pi.Name <> "Produit 1" Or pi.Name <> "Produit 2" Then
                pi.Visible = False
                End If
                'On Error GoTo 0
            Next pi
        End With

        With pt.PivotFields("Dépot")
            .ClearAllFilters
            .EnableMultiplePageItems = True
            For Each pi In pt.PivotFields("Dépot").PivotItems
            'On Error Resume Next
                If pi.Name <> "Dépot 1" Or pi.Name <> "Dépot 2" Or pi.Name <> "Dépot 3" Then
                pi.Visible = False
                End If
            'On Error GoTo 0
            Next pi
        End With

Application.ScreenUpdating = True
End Sub

Mais j'ai une erreur "1004 Impossible de définir la propriété Visible de la classe PivotItem" sur la ligne :

pi.Visible = False

Bonjour,

Voici une proposition de réorganisation du code :

Option Explicit

Sub FilterPivotTable()
Dim pt As PivotTable
Dim pfs as PivotFields, pf as pivotfield
Dim pi As PivotItem

Application.ScreenUpdating = False
Set pt = Sheets("TCD_Jour").PivotTables("TCD2")
set pfs = pt.pivotfields 'collection des champs

for each pf in pt.pfs 'pour chaque champ de la collection
    nompf = pf.name   'nom du pf
    With pf 'avec le champ
        if .name = "Produit" or .name = "Dépot" then 'si produit ou depot
            .ClearAllFilters 'effacer filtres
            .EnableMultiplePageItems = True '?
            For Each pi In pf.PivotItems 'pour chaque item de la collection pivotitems
                If not pi.Name like nompf & iif(nompf = "Produit", " [1-2]", " [1-3]") Then 'si nom pi different de nompf & " " & (1 ou 2 quand pf = "Produit" ou 1, 2 ou 3 sinon)
                    pi.Visible = False 'pi masqué
                End If
            Next pi
        end if
    End With
next pf

Application.ScreenUpdating = True

End Sub

Je ne m'y connais par particulièrement en TCD mais il est possible qu'il faille au minimum un pivotitem visible. Or, vos conditions rendent tous les pi invisibles car il y a un "Or" à la place d'un "and". Si ma supposition se vérifiait, alors ça expliquerait l'erreur.

Cdlt,

Bonjour 3GB,

Merci beaucoup pour votre réponse.

J'ai effectivement suivi cette hypothèse et il semblerait que le problème vienne de là.

Excellente fin de journée à vous

Bonjour à tous

Tes TCD ont la même source, pourquoi ne pas tout simplement utiliser des segments synchronisant leurs filtres ?

Un ou 2 clics plutôt qu'un code...

Un TCD doit avoir comme source un tableau structuré et non une plage sinon il n'évoluera plus

Bonjour 78Chris,

Merci pour cette suggestion, mais le fichier est destiné à des utilisateurs très peu à l'aise avec l'informatique en général, et encore plus avec Excel...

J'essaie de faire au plus simple, pour eux...

Bonjour à tous

J'ai testé le code de 3GB mais la ligne

If not pi.Name like nompf & iif(nompf = "Produit", " [1-2]", " [1-3]") Then 

semble poser problème, le [1-3] n'étant pas pris comme une liste d'alternatives

Une autre solution : ajouter à la source une colonne Filtre, permanente ou via vba, formulée ainsi

=SI(ET(OU([@Produit]="Produit 1";[@Produit]="Produit 2");OU([@Dépot]="Dépôt 1";[@Dépot]= "Dépôt 2";[@Dépot]="Dépôt 3");SUBSTITUE([@Date];".";"/")*1=AUJOURDHUI());1;0)

Utiliser cette colonne en zone de Filtre et filtrer définitivement le TCD sur 1

On peut élégamment passer par PowerQuery, intégré à Excel à partir de 2016, pour préfiltrer et bâtir le TCD sur la requête

Bonjour 78chris,

Je rencontre effectivement le même problème.

J'ai rajouté une colonne Filtre à la source, ce qui me convient parfaitement

Merci beaucoup pour ton aide !