XL 2013 Alimenter champs TCD par listes déroulantes

Christophe

XLDnaute Occasionnel
Bonjour le Forum,

Je souhaite alimenter par un code VBA les champs de tableaux croisés dynamiques selon une liste déroulante, elle même alimentée par les champs des TCD.
En PJ un exemple très simplifié
je choisis "Marseille" dans l'onglet "choix"
Cela alimente les flitres de l'onglet TCD (F1, J1, N1).
Je choisis "Bar" dans l'onglet "Choix"
Cela alimente les filtres de l'onglet TCD (J2, N3)
Et ainsi de suite ...

Merci par avance de votre aide.

Bonne journée
 

Pièces jointes

  • ED_TCD1.xlsx
    21.9 KB · Affichages: 8

chris

XLDnaute Barbatruc
Bonjour

Pourquoi faire simple quand on peut faire compliqué ?

Tu as les segments sur les TCD et sur les tableaux structurés : donc 2 solutions sans créer d'usine à gaz VBA pour synchroniser une liste et 3 TCD

De plus les segment se préfiltrent les uns les autres contrairement aux listes déroulantes qui risquent de sélectionner des cas inexistants
 

Pièces jointes

  • ED_TCD.xlsx
    23.2 KB · Affichages: 11

Christophe

XLDnaute Occasionnel
Bonjour Chris
Merci de ta réponse et ta proposition.
Cependant elle ne répond pas à mon besoin.
Car en fait j'ai besoin de reporter les choix sur de multiples TCD, alimentés par des sources différentes.

Merci par avance de ton aide.

Bon appétit
 

Christophe

XLDnaute Occasionnel
Bonjour Chris
Merci de me remettre sur le droit chemin ;)
La solution proposée avec les segments semble en effet pouvoir répondre à mon besoin.
N'était ni familier des segments, ni de VBA, que dois changer / personnaliser dans le code pour l'appliquer ?

merci encore

Bonne fin de journée
 

chris

XLDnaute Barbatruc
RE

Ceci dans le module ThisWorkbook : seul le nom de la feuille, ici Budget est à modifier

Cependant ce type d'exercice avec des sources différentes nécessite que les noms des champs alimentant les segments soit les mêmes et, que ce soit avec ou sans segments, que les éléments existent dans toutes les sources

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

Discussions similaires

Statistiques des forums

Discussions
311 719
Messages
2 081 871
Membres
101 828
dernier inscrit
Did-Pan