Figer les slicers

[Maddad]

Bonjour à tous,

j'ai crée un tableau croisé dynamique avec des slicers (segments dans excel 2010), mais ces derniers changent souvent de position chaque fois que je filtre des données. Je voudrais savoir comment les rendre immobiles.

Merci d'avance

 

[MichD]

Re : Figer les slicers

Bonjour,


Tu colles le code suivant dans le module de la feuille où se situe ton tdc
Tu peux adapter les index pour le nom des objets si tu le désires!

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim Pt As PivotTable
Dim x As Slicer
Set Pt = Me.PivotTables(1)
Set x = Target.Slicers(1)
'Tu choisis les propriétés Left Et top de
'la cellule que tu désires...
x.Shape.Left = Me.Range("D8").Left
x.Shape.Top = Me.Range("D8").Top
'x.Width = si besoin
End Sub

 

[Maddad]

Re : Figer les slicers

Bonjour,

Merci pour ta réponse, j'ai modifié la macro car je voulais figer plusieurs slicers et les coller les uns aux autres, et ce de façon synchrone à toute action de sélection sur le tableau:

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim Pt As PivotTable
Set Pt = Me.PivotTables(1)
Set x = Target.Slicers("année")
Set y = Target.Slicers("PVP")
Set Z = Target.Slicers("Analyses DPRO")
Set w = Target.Slicers("Unité" & Chr(10) & "responsable" & Chr(10) & "de l'analyse de" & Chr(10) & "risques")
Set v = Target.Slicers("Entité")
x.Shape.Left = Me.Range("A1").Left: x.Shape.Top = Me.Range("A1").Top
y.Shape.Left = Me.Range("A1").Left: y.Shape.Top = Me.Range("A1").Top: y.Shape.IncrementLeft 141
Z.Shape.Left = Me.Range("A1").Left: Z.Shape.Top = Me.Range("A1").Top: Z.Shape.IncrementTop 47
w.Shape.Left = Me.Range("A1").Left: w.Shape.Top = Me.Range("A1").Top: w.Shape.IncrementTop 47: w.Shape.IncrementLeft 141
v.Shape.Left = Me.Range("A1").Left: v.Shape.Top = Me.Range("A1").Top: v.Shape.IncrementLeft 282
'x.Width = si besoin
End Sub

ça marche, mais comme je viens de commencer avec les macros, je ne sais pas si la macro est optimale et de ce fait pourrait être améliorée

A+

 

[MichD]

Re : Figer les slicers

L'important c'est que tu as trouvé une solution qui convient à ton application.

Pour ce qui est de l'optimisation du code, cela s'acquiert avec la pratique...

Si c'est pour sauver quelques nanosecondes, je te suggère de ne pas perdre un temps fou sur le sujet!

 

[Maddad]

Re : Figer les slicers

Resalut,

voici la macro encore modifié afin qu'elle ne prenne pas en compte le nom des slicers (au cas ou je voudrais en ajouter de nouveaux avec des noms différents) + ajustement de la taille de ces derniers :

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim Pt As PivotTable
Set Pt = Me.PivotTables(1)

Set x = Target.Slicers(1): x.Shape.Height = 48.188976378: x.Shape.Width = 141.7322834646: x.Shape.Left = Me.Range("A1").Left: x.Shape.Top = Me.Range("A1").Top
Set y = Target.Slicers(2): y.Shape.Height = 48.188976378: x.Shape.Width = 141.7322834646: y.Shape.Left = Me.Range("A1").Left: y.Shape.Top = Me.Range("A1").Top: y.Shape.IncrementLeft 141
Set Z = Target.Slicers(3): Z.Shape.Height = 48.188976378: x.Shape.Width = 141.7322834646: Z.Shape.Left = Me.Range("A1").Left: Z.Shape.Top = Me.Range("A1").Top: Z.Shape.IncrementTop 47
Set w = Target.Slicers(4): w.Shape.Height = 48.188976378: x.Shape.Width = 141.7322834646: w.Shape.Left = Me.Range("A1").Left: w.Shape.Top = Me.Range("A1").Top: w.Shape.IncrementTop 47: w.Shape.IncrementLeft 141
Set v = Target.Slicers(5): v.Shape.Height = 48.188976378: x.Shape.Width = 141.7322834646: v.Shape.Left = Me.Range("A1").Left: v.Shape.Top = Me.Range("A1").Top: v.Shape.IncrementLeft 282
'x.Width = si besoin
End Sub

Mais lorsque je veux afficher moins de 5 slicers ça bug, serait-il possible d'ajouter une condition à la macro afin d'éviter cela, du genre si un slicer est absent : pas d'action

merci

 

[Maddad]

Re : Figer les slicers

J'ai également rajouter un commandbutton "fichier source" pour aller vers la feuille de base de données, je voudrais également ajuster sont format et sa position par VBA

merci pour votre aide

 

[MichD]

Re : Figer les slicers

Si tu places tous les slicers au même endroit, cela devrait être suffisant

J'ai supposé que tu avais seulement un TDC dans la feuille et ses slicers.
Sinon, il faut spécifier le TDC.

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim Sl As Slicer
For Each Sl In Target.Slicers
    With Sl.Shape
        .Height = 48.188976378
        .Width = 141.7322834646
        .Left = Me.Range("A1").Left
        .Top = Me.Range("A1").Top
    End With
Next
End Sub

Si tu as plusieurs TDC dans la feuille, tu peux modifier la macro comme suit :

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable)
Dim Sl As Slicer
Select Case LCase(Target.Name)
    Case Is = "toto"
        For Each Sl In Target.Slicers
            With Sl.Shape
                .Height = 48.188976378
                .Width = 141.7322834646
                .Left = Me.Range("A1").Left
                .Top = Me.Range("A1").Top
            End With
        Next
    Case Is = "titi"
        For Each Sl In Target.Slicers
            With Sl.Shape
                .Height = "à définir"
                .Width = "à définir"
                .Left = "à définir"
                .Top = "à définir"
            End With
        Next
    Case Is = "tata"
        For Each Sl In Target.Slicers
            With Sl.Shape
                .Height = "à définir"
                .Width = "à définir"
                .Left = "à définir"
                .Top = "à définir"
            End With
        Next
End Select
End Sub

 

[Maddad]

Re : Figer les slicers

Merci pour ta réponse