VBA mise à jour filtres

bonjour,

J'ai plusieurs tableaux croisés dynamiques dans une feuille.

Pou actualiser ces TCDs, je n'ai pas de problèmes mais pour les filtres, ça ne marche pas.

Voici le code que j'ai écrit mais qui ne fonctionne pas.

Pourriez-vous m'aider ?

Merci beaucoup

Cordialement

Sub Test ()

Application.ScreenUpdating = False

Dim i As Byte
With Sheets("Feuil1")
  For i = 1 To .PivotTables.Count
  .PivotTables(i).PivotCache.Refresh
   Next i
End With

Dim pt As PivotTable, pi As PivotItem
pt = ActiveSheet.PivotTables("Tableau croisé dynamique1")
    With pt.PageFields("CATEGORIE")
    .ClearAllFilters
    If pi.Value <> "C1" And pi.Value <> "C2" And pi.Value <> "C3" And pi.Value <> "C4" And pi.Value <> "S1" And pi.Value <> "S2" And pi.Value <> "S3" Then pi.Visible = False
    End With
    On Error Resume Next

pt = ActiveSheet.PivotTables("Tableau croisé dynamique3")
    With pt.PageFields("CATEGORIE")
    .ClearAllFilters
    If pi.Value <> "N1" And pi.Value <> "O1" And pi.Value <> "O2" And pi.Value <> "O4" And pi.Value <> "P1" And pi.Value <> "P2" Then pi.Visible = False
    End With
    On Error Resume Next

pt = ActiveSheet.PivotTables("Tableau croisé dynamique4")
    With pt.PageFields("CATEGORIE")
    .ClearAllFilters
    If pi.Value <> "B1" And pi.Value <> "B2" And pi.Value <> "M1" And pi.Value <> "M2" And pi.Value <> "M3" And pi.Value <> "M4" And pi.Value <> "M5" And pi.Value <> "EML" Then pi.Visible = False
    End With
    On Error Resume Next

Bonjour

Pour vous aider à comprendre mon besoin, je joints un fichier exemple.

Ce que je souhaite, c'est pouvoir sélectionner par macro certains items dans les filtres des TCDs.

Je reste à votre disposition pour toutes informations complémentaires.

Cordialement

14exemple.xlsm (29.22 Ko)

Annule et remplace précédent fichier.

Bonjour,

Une procédure à tester.

Cdlt.

Public Sub DEMO()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strPF As String

    Application.ScreenUpdating = False
    Set ws = ActiveWorkbook.Worksheets("TCDs")    'Nom à adapter
    strPF = "CATEGORIE"

    For Each pt In ws.PivotTables
        pt.PivotCache.Refresh
        pt.PageFields(strPF).ClearAllFilters
        pt.PageFields(strPF).EnableMultiplePageItems = True
    Next pt

    Set pt = ws.PivotTables("Tableau croisé dynamique1")
    For Each pi In pt.PageFields(strPF).PivotItems
        Select Case pi.Value
            Case "C1", "C2", "C3", "C4", "S1", "S2", "S3"
                pi.Visible = True
            Case Else
                pi.Visible = False
        End Select
    Next pi
    Set pt = Nothing

    Set pt = ws.PivotTables("Tableau croisé dynamique3")
    For Each pi In pt.PageFields(strPF).PivotItems
        Select Case pi.Value
            Case "N1", "O1", "O2", "O4", "P1", "P2"
                pi.Visible = True
            Case Else
                pi.Visible = False
        End Select
    Next pi
    Set pt = Nothing

    Set pt = ws.PivotTables("Tableau croisé dynamique4")
    For Each pi In pt.PageFields(strPF).PivotItems
        Select Case pi.Value
            Case "B1", "B2", "M1", "M2", "M3", "M4", "M5", "EML"
                pi.Visible = True
            Case Else
                pi.Visible = False
        End Select
    Next pi
    Set pt = Nothing

    Application.ScreenUpdating = False
    MsgBox "Mise à jour des montants effectuée", vbInformation

    Set ws = Nothing

End Sub

Bonjour Jean-Eric,

J'ai testé et ça marche très bien.

Merci infiniment pour ton aide.

Bien cordialement

Re Clacha,

Si tu es satisfait, pense à clore le sujet.

Cdlt.

ok j'ai fermé le sujet.

Merci beaucoup.

Bonne soirée

Rebonjour

Je me permets de revenir sur ce post fermé.

En effet, quand je transpose cet exemple (qui fonctionne parfaitement) à mon vrai fichier, j'ai eu un msg d'erreur :

Erreur d'exécution 1004

Impossible de définir la propriété Visible de la classe PivotItem

En essayant de comprendre, je pense que cela vient des catégories : "O1" et "C2". Elles sont absentes de mes données.

Comment contourner ce pb que je ne comprends pas ? Sachant que dans le fichier exemple, je n'ai pas eu le pb malgré l'absence de ces deux catég.

Merci pour ce complément.

Bien cordialement

Re,

Quelle est la ligne de code surlignée en jaune lors du message d'erreur?

Cdlt.

Merci pour ta réponse.

La ligne de code en jaune est : pi.Visible = True

dans

Case "N1", "O1", "O2", "O4", "P1", "P2"

pi.Visible = True

Cordialement

Re,

Dans les options du TCD, assure toi que dans Données, que tu ne conserves pas les éléments supprimés de la source des données.

(Nombre d'éléments à retenir par champ = Aucun).

A te relire.

Cdlt.

La solution était bien dans les options des TCDs.

J'avais l'option suivante sur mes TCDs : Nombre d'éléments à retenir par champ = Automatique au lieu de Aucun

Merci beaucoup pour ton aide, c'est super sympa de m'avoir aidée.

Bien cordialement

Rechercher des sujets similaires à "vba mise jour filtres"