Microsoft 365 VBA-synchro slicer differentes feuilles ( differents sources ).

A

almourasel

XLDnaute Occasionnel
salut les amis

j'ai ce code qu fait la synchornisation entre les slicers mais le problème qu'il est un peu lourd , est ce qu il ya un moyen de le modifier pour que son excusion sera plus rapide ?

il consomme de temps qu'on je filtre avec SC3 et SC4.

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

' These names come from Slicer Settings dialog box
Set sc1 = ThisWorkbook.SlicerCaches("Slicer_line")
Set sc2 = ThisWorkbook.SlicerCaches("Slicer_line1")
Set sc3 = ThisWorkbook.SlicerCaches("Slicer_Drawg")
Set sc4 = ThisWorkbook.SlicerCaches("Slicer_DRW")

Application.ScreenUpdating = False
Application.EnableEvents = False

sc2.ClearManualFilter
sc4.ClearManualFilter

For Each SI1 In sc1.SlicerItems
sc2.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
 
Trier par date Trier par votes
D

danielco

XLDnaute Accro
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 ?

Annotation 2020-08-30 130234.png


Daniel
 
Dernière édition:
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
Sinon, ça donnerait :

VB: 
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

Daniel
 
Vote positif 0 Vote négatif
A

almourasel

XLDnaute Occasionnel
danielco à dit:
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.


1598798975696.png


Daniel
Cliquez pour agrandir...
 
Dernière édition:
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
Voila 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
 
Vote positif 0 Vote négatif
A

almourasel

XLDnaute Occasionnel
danielco à dit:
Voila 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
Cliquez pour agrandir...
Salut Daniel

j'ai changé vers dans la feuille History Plan de Jig fix vers Fixed JIG comme les autres Slicers.
le programe fonctionne mais comme t'as mentionnée il reste seulement le problème avec le slicer DRW1 qui est reliver avec la feuille History plan .

1598801571245.png
 
Dernière édition:
Vote positif 0 Vote négatif
A

almourasel

XLDnaute Occasionnel
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
A

almourasel

XLDnaute Occasionnel
danielco à dit:
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
Cliquez pour agrandir...

Salut Daniel

avec le nouveau code il affiche les familles par rapport la ligne et ne filtre pas par Drawing.

1598805088033.png


le Slicer séléctionner pour DRW A1775400441 mais son tableau croisé dynamique affiche des autres familles totalement en plus dus Drawing désire , ici il a ajouter A1775406831+les autres qui sont de choix arbitraire.


1598805149318.png
 
Vote positif 0 Vote négatif
A

almourasel

XLDnaute Occasionnel
danielco à dit:
Il y a apparemment des items comme "A1775406831" qui ne figurent pas dans le segment "drawg".

Daniel
Cliquez pour agrandir...
Salut Daniel

oui exactement , je les ajouté manuellement et sa marche Super Maintenant.
toute les Slicers doivent avoir les mêmes items si non se ne vas pas.

Juste dernière demande si possible svp : est ce qu'il ya une possiblité de reduire le temps de traitement de l'info car avec chaque selection sa prend un peu de temps ( je pense a cause le grand nombre d'info inclus dans le fichier , c sa ? ).

merci Bcp Daniel pour votre support et votre patience .
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Comment intégrer une progressbar pour montrer l'évolution de la synchro des TCDS
Réponses
1
Affichages
878
scoubidou35
S
G
  • Question
XL 2013 Excel 2013 : VBA - Afficher les items sélectionnés dans 2 segments ou plus
Réponses
0
Affichages
2 K
GMeunier
G

Membres actuellement en ligne

9 membres et 76 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 276
Messages
2 086 711
Membres
103 377
dernier inscrit
fredy45