Option Base 1
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim Ninsert&, espace&, a(), i&, col%, j&, z&
Ninsert = 100 'à adapter
Application.ScreenUpdating = False
ReDim a(1 To Sh.PivotTables.Count, 3)
If UBound(a, 1) = 1 Then Exit Sub
'Synchro segments
If Sh.Name = "FICHES I.T.K" And Target.Name = "TCD_1" Then
Application.EnableEvents = False
ActiveWorkbook.SlicerCaches("Segment_SITES1").ClearManualFilter
ActiveWorkbook.SlicerCaches("Segment_SITES2").ClearManualFilter
For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_SITES").SlicerItems
Trouve1 = False: Trouve2 = False
For Each Iitem1 In ActiveWorkbook.SlicerCaches("Segment_SITES1").SlicerItems
If Iitem1.Name = Iitem.Name Then
Trouve1 = True
Iitem1.Selected = Iitem.Selected
Exit For
End If
Next Iitem1
If Trouve1 = False Then Iitem.Selected = False
For Each Iitem2 In ActiveWorkbook.SlicerCaches("Segment_SITES2").SlicerItems
If Iitem2.Name = Iitem.Name Then
Trouve2 = True
Iitem2.Selected = Iitem.Selected
Exit For
End If
Next Iitem2
If Trouve2 = False Then Iitem.Selected = False
Next Iitem
Application.EnableEvents = True
End If
'Espacement TCD
With Sh
.Cells.EntireRow.Hidden = False
For i = 1 To UBound(a, 1)
a(i, 1) = .PivotTables(i).TableRange2.Row
a(i, 2) = .PivotTables(i).TableRange2.Rows.Count
Next
Call tri(a(), 1, UBound(a, 1), 2, 1)
'---insertion ou suppression de lignes---
For i = 1 To UBound(a, 1) - 1
espace = a(i + 1, 1) - (a(i, 1) + a(i, 2))
If espace < Ninsert Then a(i, 3) = Ninsert - espace Else a(i, 3) = Ninsert - espace
Next
For i = UBound(a, 1) To 2 Step -1
z = a(i - 1, 3)
If z > 0 Then
.Rows(a(i - 1, 1) + a(i - 1, 2)).Resize(z).Insert
ElseIf z < 0 Then
z = -z
.Rows(a(i - 1, 1) + a(i - 1, 2)).Resize(z).EntireRow.Delete
End If
'Masquage
.Rows(a(i - 1, 1) + a(i - 1, 2) & ":" & a(i, 1) + a(i - 1, 3) - 2).EntireRow.Hidden = True
Next
End With
End Sub