Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sc1 As SlicerCache
Dim SI1 As SlicerItem
Dim SC As SlicerCache
' These names come from Slicer Settings dialog box
Application.ScreenUpdating = False
Application.EnableEvents = False
Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Line")
For Each SC In ThisWorkbook.SlicerCaches
If SC.Name <> "Slicer_Line" Then
SC.ClearManualFilter
End If
Next SC
' On Error Resume Next
For Each SI1 In sc1.SlicerItems
For Each SC In ThisWorkbook.SlicerCaches
If SC.Slicers(1).Caption = "Line" Then
SC.SlicerItems(SI1.Name).Selected = SI1.Selected
End If
Next SC
Next SI1
' On Error GoTo 0
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
J'ai un problème parce que le nouveau segment a un item "Jig Fix" alors que le segment modèle a "Fixed jig". Une idée ?
Regarde la pièce jointe 1077168
Salut Daniel
sa marche super le premier code mais ce slicer Drawg n est plus actif .
Slicer_Drawg doit être relier avec Slicer_DRW1 et Slicer_DRW.
comment faire l ajouter de nouveau svp.
Daniel
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sc1 As SlicerCache
Dim sc2 As SlicerCache
Dim SI1 As SlicerItem
Dim sc3 As SlicerCache
Dim sc4 As SlicerCache
Dim SI3 As SlicerItem
Dim sc5 As SlicerCache
Dim SI5 As SlicerItem
' These names come from Slicer Settings dialog box
Set Var = ThisWorkbook.SlicerCaches
Set Var1 = ThisWorkbook.PivotCaches
Set var2 = Sheets("history plan").PivotTables
Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Line")
Set sc2 = ThisWorkbook.SlicerCaches("Slicer_line1")
Set sc3 = ThisWorkbook.SlicerCaches("Slicer_Drawg")
Set sc4 = ThisWorkbook.SlicerCaches("Slicer_DRW")
Set sc5 = ThisWorkbook.SlicerCaches("Slicer_Line2")
Application.ScreenUpdating = False
Application.EnableEvents = False
sc2.ClearManualFilter
sc4.ClearManualFilter
sc5.ClearManualFilter
For Each SI1 In sc1.SlicerItems
sc2.SlicerItems(SI1.Name).Selected = SI1.Selected
sc5.SlicerItems(SI1.Name).Selected = SI1.Selected
Next SI1
For Each SI3 In sc3.SlicerItems
sc4.SlicerItems(SI3.Name).Selected = SI3.Selected
Next SI3
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Salut DanielVoila ma copie modifiée (avec toujours ce problème avec "Fixed JIG").
VB:Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) Dim sc1 As SlicerCache Dim sc2 As SlicerCache Dim SI1 As SlicerItem Dim sc3 As SlicerCache Dim sc4 As SlicerCache Dim SI3 As SlicerItem Dim sc5 As SlicerCache Dim SI5 As SlicerItem ' These names come from Slicer Settings dialog box Set Var = ThisWorkbook.SlicerCaches Set Var1 = ThisWorkbook.PivotCaches Set var2 = Sheets("history plan").PivotTables Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Line") Set sc2 = ThisWorkbook.SlicerCaches("Slicer_line1") Set sc3 = ThisWorkbook.SlicerCaches("Slicer_Drawg") Set sc4 = ThisWorkbook.SlicerCaches("Slicer_DRW") Set sc5 = ThisWorkbook.SlicerCaches("Slicer_Line2") Application.ScreenUpdating = False Application.EnableEvents = False sc2.ClearManualFilter sc4.ClearManualFilter sc5.ClearManualFilter For Each SI1 In sc1.SlicerItems sc2.SlicerItems(SI1.Name).Selected = SI1.Selected sc5.SlicerItems(SI1.Name).Selected = SI1.Selected Next SI1 For Each SI3 In sc3.SlicerItems sc4.SlicerItems(SI3.Name).Selected = SI3.Selected Next SI3 Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Daniel
Oui ?
Daniel
Salut DanielIl n'y a pas de feuille Dashboard dans ton classeur.
Daniel
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sc1 As SlicerCache
Dim sc2 As SlicerCache
Dim SI1 As SlicerItem
Dim sc3 As SlicerCache
Dim sc4 As SlicerCache
Dim SI3 As SlicerItem
Dim sc5 As SlicerCache
Dim SI5 As SlicerItem
Dim sc6 As SlicerCache
Dim SI6 As SlicerItem
' These names come from Slicer Settings dialog box
Set Var = ThisWorkbook.SlicerCaches
Set Var1 = ThisWorkbook.PivotCaches
Set var2 = Sheets("history plan").PivotTables
Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Line")
Set sc2 = ThisWorkbook.SlicerCaches("Slicer_line1")
Set sc3 = ThisWorkbook.SlicerCaches("Slicer_Drawg")
Set sc4 = ThisWorkbook.SlicerCaches("Slicer_DRW")
Set sc5 = ThisWorkbook.SlicerCaches("Slicer_Line2")
Set sc6 = ThisWorkbook.SlicerCaches("Slicer_DRW1")
Application.ScreenUpdating = False
Application.EnableEvents = False
sc2.ClearManualFilter
sc4.ClearManualFilter
sc5.ClearManualFilter
sc6.ClearManualFilter
For Each SI1 In sc1.SlicerItems
sc2.SlicerItems(SI1.Name).Selected = SI1.Selected
sc5.SlicerItems(SI1.Name).Selected = SI1.Selected
Next SI1
For Each SI3 In sc3.SlicerItems
sc4.SlicerItems(SI3.Name).Selected = SI3.Selected
sc6.SlicerItems(SI3.Name).Selected = SI3.Selected
Next SI3
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Essaie :
VB:Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) Dim sc1 As SlicerCache Dim sc2 As SlicerCache Dim SI1 As SlicerItem Dim sc3 As SlicerCache Dim sc4 As SlicerCache Dim SI3 As SlicerItem Dim sc5 As SlicerCache Dim SI5 As SlicerItem Dim sc6 As SlicerCache Dim SI6 As SlicerItem ' These names come from Slicer Settings dialog box Set Var = ThisWorkbook.SlicerCaches Set Var1 = ThisWorkbook.PivotCaches Set var2 = Sheets("history plan").PivotTables Set sc1 = ThisWorkbook.SlicerCaches("Slicer_Line") Set sc2 = ThisWorkbook.SlicerCaches("Slicer_line1") Set sc3 = ThisWorkbook.SlicerCaches("Slicer_Drawg") Set sc4 = ThisWorkbook.SlicerCaches("Slicer_DRW") Set sc5 = ThisWorkbook.SlicerCaches("Slicer_Line2") Set sc6 = ThisWorkbook.SlicerCaches("Slicer_DRW1") Application.ScreenUpdating = False Application.EnableEvents = False sc2.ClearManualFilter sc4.ClearManualFilter sc5.ClearManualFilter sc6.ClearManualFilter For Each SI1 In sc1.SlicerItems sc2.SlicerItems(SI1.Name).Selected = SI1.Selected sc5.SlicerItems(SI1.Name).Selected = SI1.Selected Next SI1 For Each SI3 In sc3.SlicerItems sc4.SlicerItems(SI3.Name).Selected = SI3.Selected sc6.SlicerItems(SI3.Name).Selected = SI3.Selected Next SI3 Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Daniel
Salut DanielIl y a apparemment des items comme "A1775406831" qui ne figurent pas dans le segment "drawg".
Daniel