XL 2013 Synchroniser des segments / filtres de TCD avec VBA, sans PowerQuery

Chrystel01

XLDnaute Occasionnel
Bonjour,

J'ai 2 TCD issus de bases différentes : base des balances et base de ratios pour un ensemble d'entreprises. Elles ont quelques champs communs dont par ex le code Tiers et l'année.
Si je veux interroger un tiers et une année particulière, je dois répéter ma sélection sur les 2 tableaux (2 tableau sur cet ex pour simplifier mais j'en ai plus en réalité )
Je vous joints un exemple pour être plus claire.

Je souhaiterais que l'utilisateur ne sélectionne qu'une fois le tiers, l'année et que tous les TCD soient filtrés sur ce tiers même s'ils sont issus de bases différentes grâce à code VBA .

Et si on ne peut pas synchroniser directement les segments avec un code, je me dis que je pourrais créer une liste de validation - déclarer en variables le choix du tiers et de l'année et filtrer ensuite les TCD sur ces variables mais j'ai du mal...

Sauriez-vous m'aider SVP ?

Je vous remercie par avance

Chrystel
 

Pièces jointes

  • TEST SYNCHRO SEGMENTS.xlsx
    41.4 KB · Affichages: 2
Solution
Bonjour

Sh fait partie des arguments de la fonction : ne surtout pas changer

En revanche "pivots" peut être modifié si tu veux appeler ta feuille autrement

Vérification faite ce code servait pour n slicers d'un même champ et non n slicers de n champs

VB:
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable)
'Synchro des segments de la feuille nommée "pivots"
    If Sh.Name <> "pivots" Then Exit Sub
    For Each Seg In ActiveWorkbook.SlicerCaches
        For Each PTlien In Seg.PivotTables
            If PTlien = Target.Name Then
                Application.EnableEvents = False
                On Error GoTo Fin
                For Each Seg2 In ActiveWorkbook.SlicerCaches
                    If...

chris

XLDnaute Barbatruc
Bonjour

J'avais fait ce code en 2013 pour cela
A adapter
VB:
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
'Synchro des segments de la feuille nommée "pivots"
    If Sh.Name <> "pivots" Then Exit Sub
    For Each Seg In ActiveWorkbook.SlicerCaches
        For Each PTlien In Seg.PivotTables
            If PTlien = Target.Name Then
                Application.EnableEvents = False
                For Each Seg2 In ActiveWorkbook.SlicerCaches
                    If Seg2.Name <> Seg.Name Then ActiveWorkbook.SlicerCaches(Seg2.Name).ClearManualFilter
                Next Seg2
                For Each Iitem In ActiveWorkbook.SlicerCaches(Seg.Name).SlicerItems
                    For Each Seg2 In ActiveWorkbook.SlicerCaches
                        If Seg2.Name <> Seg.Name Then ActiveWorkbook.SlicerCaches(Seg2.Name).SlicerItems(Iitem.Name).Selected = Iitem.Selected
                    Next Seg2
                Next Iitem
                Application.EnableEvents = True
            End If
        Next
    Next
End Sub
 

Chrystel01

XLDnaute Occasionnel
Bonjour Chris,
Bonjour le Forum,

Merci beaucoup pour ce code VBA !

J'essaye de l'appliquer mais je n'arrive pas à le faire fonctionner ... j'ai des difficultés pour l'adapter en totalité car je ne le comprends pas entièrement ...
J'ai copié la macro dans le "workbook",renommé ma feuille pivot, remplacé sh.name. par sheet.name pour ne pas déclarer la variable... Mais rien ne se passe ( j'ai joint mon doc avec la macro)
Je pense que d'autres variables sont à créer ? Seg, seg2, Pt lien ?
Pourriez-vous svp m'aider à l'adapter à mon cas pratique ?

Je vous remercie pour votre aide

Chrystel
 

Pièces jointes

  • TEST SYNCHRO SEGMENTS v2.xlsm
    47.4 KB · Affichages: 2

chris

XLDnaute Barbatruc
Bonjour

Sh fait partie des arguments de la fonction : ne surtout pas changer

En revanche "pivots" peut être modifié si tu veux appeler ta feuille autrement

Vérification faite ce code servait pour n slicers d'un même champ et non n slicers de n champs

VB:
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable)
'Synchro des segments de la feuille nommée "pivots"
    If Sh.Name <> "pivots" Then Exit Sub
    For Each Seg In ActiveWorkbook.SlicerCaches
        For Each PTlien In Seg.PivotTables
            If PTlien = Target.Name Then
                Application.EnableEvents = False
                On Error GoTo Fin
                For Each Seg2 In ActiveWorkbook.SlicerCaches
                    If Seg2.Name <> Seg.Name And (Left(Seg.Name, Len(Seg.Name)) = Left(Seg2.Name, Len(Seg2.Name) - 1) Or _
                            Left(Seg2.Name, Len(Seg2.Name)) = Left(Seg.Name, Len(Seg.Name) - 1)) Then
                        ActiveWorkbook.SlicerCaches(Seg2.Name).ClearManualFilter
                        For Each Iitem In ActiveWorkbook.SlicerCaches(Seg.Name).SlicerItems
                            ActiveWorkbook.SlicerCaches(Seg2.Name).SlicerItems(Iitem.Name).Selected = Iitem.Selected
                        Next Iitem
                    End If
                Next Seg2
            End If
        Next PTlien
    Next Seg
Fin:
Application.EnableEvents = True
End Sub

Il part du principe que les slicers concernant un même champ ont le même nom à l'indice final près
 

Pièces jointes

  • TEST SYNCHRO SEGMENTS v3.xlsm
    51.3 KB · Affichages: 8

Chrystel01

XLDnaute Occasionnel
Bonjour Chris,

Un grand merci ! Je vois en plus que vous avez actualisé le code dans le fichier , je vous en remercie.
Je comprends donc que le code ne comportait aucune variable à définir.
Quand je sélectionne un segment dans un des 2 TCD (ex l'année 2020), l'autre TCD ne se modifie pas en conséquence et reste sur 2021... J'oublie une manipulation ?

Merci pour votre aide

Chrystel
 

chris

XLDnaute Barbatruc
Bonjour

Cela fonctionne bien chez moi sur le classeur posté.

Sur celui de gauche tu as mis les mêmes données pour 2020 et 2021 donc à part le champ de page on ne voit rien bouger
Sur celui de droite on voit les valeurs changer (testé sur 2010 et 365)
 

Chrystel01

XLDnaute Occasionnel
Bonjour,

Effectivement, je n'avais pas du ouvrir le bon classeur... Désolée...

Alors un grand merci Chris ! Cette fonctionnalité que tu as créée me soulage énormément et va m'être très utile et dans de multiples cas.

Bonne semaine

Chrystel
 

Discussions similaires

Statistiques des forums

Discussions
312 205
Messages
2 086 199
Membres
103 156
dernier inscrit
Ludo94130