Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
If Sh.Name = "Budget" Then Call Synchro_Segments(Sh.CodeName, Target)
End Sub
Sub Synchro_Segments(Feuille, TCD)
'Synchro des segments de la feuille
Dim SegmentF 'Table des segments liés au TCD + segments de nom similaire
Dim y As Long 'Dimension de la table
Dim Seg As SlicerCache 'Segments analysés
Dim X As Integer 'Nombre de segments du classeur
X = ActiveWorkbook.SlicerCaches.Count
ReDim SegmentF(X)
''
'Table des segments liés au TCD filtré
'Les segments sont supposés avec le même nom suivi de _ puis un numéro différent pour un même champ
'Le premier de la série est celui lié au TCD qui déclenche le code
For i = 1 To X
Set Seg = ActiveWorkbook.SlicerCaches(i)
If Seg.PivotTables(1) = TCD Then
If y = X Then Exit For Else y = y + 1: SegmentF(y) = Seg.Name
End If
Next i
For i = 1 To X
Set Seg = ActiveWorkbook.SlicerCaches(i)
If Seg.PivotTables(1) <> TCD Then
y = y + 1: SegmentF(y) = Seg.Name
End If
If y = X Then Exit For Else
Next i
ReDim Preserve SegmentF(y)
'Filtre
On Error GoTo FIN
Application.EnableEvents = False
For i = 1 To X
For j = i + 1 To X
If SegRacine(SegmentF(i)) = SegRacine(SegmentF(j)) Then
ActiveWorkbook.SlicerCaches(SegmentF(j)).ClearManualFilter
For Each Iitem In ActiveWorkbook.SlicerCaches(SegmentF(j)).SlicerItems
For Each Iitem2 In ActiveWorkbook.SlicerCaches(SegmentF(i)).SlicerItems
If Iitem.Name = Iitem2.Name Then ActiveWorkbook.SlicerCaches(SegmentF(j)).SlicerItems(Iitem.Name).Selected = Iitem2.Selected: Exit For
Next Iitem2
Next Iitem
End If
Next j
Next i
FIN:
Application.EnableEvents = True
End Sub
Function SegRacine(Segment)
Nom = Mid(Segment, InStr(Segment, "_") + 1, 100)
Do While Asc(Right(Nom, 1)) >= Asc("0") And Asc(Right(Nom, 1)) <= Asc("9")
Nom = Left(Nom, Len(Nom) - 1)
Loop
SegRacine = Nom
End Function
End Sub