Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

EXCEL :: Axes des abscisses dynamiques d'un graphique construit à partir d'un tableau croisé dynamique

oguruma

XLDnaute Occasionnel
Bonjour,
chacun sait qu'il est impossible de modifier la sélection des données d'un graphique construit à partir d'un TCD. L'idée est ici de faire varier l'axe des X selon ceci



ou comme ceci



Le seul moyen d'y parvenir est d'intervenir sur les composants du TCD en VBA. Avant cela un peu de préparation et de paramétrage.

1. Construction d'un tableau des catégories représentant l'axe des X - TB_LST_CHAMPS


2. Création d'une plage nommée - LIST-CHAMPS


3. Création de la liste déroulante

Les paramètres de cette liste :


4. Référencement des paramètres dans un tableau


Le libellé sélectionné est identifié par cette formule



5. Le code VBA
Une procédure MAIN() est affectée à la déroulante comme suit

VB:
Sub MAIN(Optional sDumy As String)
    Dim vAppel As Variant
    Dim sType As String
    Dim sTCD As String
    
    On Error GoTo HANDLE_ERROR

    sType = TypeName(Application.Caller)
    Select Case sType
        Case "Range"
            vAppel = Application.Caller.Address
        Case "String"
            vAppel = Application.Caller
        Case "Error"
            vAppel = sDumy
        Case Else
            vAppel = sDumy
    End Select

    sTCD = Range(vAppel).Value
    Select Case vAppel
        Case "LC_PIVOT_FIELDS_01"
            Call CHANGE_PIVOT_FIELD_FROM_LIST(sTCD, "SELECT_LIBELLE")
        Case "LC_PIVOT_FIELDS_02"
            Call CHANGE_PIVOT_FIELD_FROM_LIST(sTCD, "SELECT_LIBELLE_02")
        Case Else
            ' NOP
    End Select

FIN:
    Exit Sub
    
HANDLE_ERROR:
    MsgBox "Erreur"
    Resume FIN
End Sub

L'astuce pour identifier la liste déroulante appelante (car la démonstration propose un graph par quantité et un graph par valeur) est de nommer cette liste et de marquer dans les paramètres sous forme de champ nommé.

Voir adressage dans la liste de champs nommés plus haut

puis tout se joue ici
VB:
 sTCD = Range(vAppel).Value
    Select Case vAppel
        Case "LC_PIVOT_FIELDS_01"
            Call CHANGE_PIVOT_FIELD_FROM_LIST(sTCD, "SELECT_LIBELLE")
        Case "LC_PIVOT_FIELDS_02"
            Call CHANGE_PIVOT_FIELD_FROM_LIST(sTCD, "SELECT_LIBELLE_02")
        Case Else
            ' NOP
    End Select

VB:
Sub CHANGE_PIVOT_FIELD_FROM_LIST(hTCD As String, hLib As String)
    Dim wkActive As Worksheet
    Dim sFieldSelectFromList As String
    Dim sFieldSelectFromSeg As String
    
    Set wkActive = ActiveSheet
    sFieldSelectFromList = Range(hLib).Value

    Call CLEANUP_TCD(wkActive, hTCD)
    Call SET_PIVOT_FIELD(wkActive, hTCD, sFieldSelectFromList, xlRowField, 1)
    
End Sub

Dans un premier temps on va nettoyer le TCD et supprimer le champ en ligne. Etant donné que l'on ignore le champ on procède par un balayage sur les champs présents en ligne.
VB:
Sub CLEANUP_TCD(hWk As Worksheet, hTCD As String)
    Dim oPivotable As PivotTable
    Dim pfField As PivotField
    Dim pfFields As PivotFields
    
    Set pfFields = hWk.PivotTables(hTCD).PivotFields

    For Each pfField In pfFields
        If pfField.Orientation = xlRowField Then
            pfField.Orientation = xlHidden
        End If
    Next pfField
   
End Sub

Puis à l'issue du nettoyage on positionne le champ sélectionné en ligne

VB:
Sub SET_PIVOT_FIELD(hWk As Worksheet, hTCD As String, hField As String, hOrientation As Integer, hPos As Integer)
    Dim oPivotable As PivotTable
    Dim pfField As PivotField
    Dim pfFields As PivotFields

    Set pfField = hWk.PivotTables(hTCD).PivotFields(hField)
    
    pfField.Orientation = hOrientation
    pfField.Position = hPos
    
End Sub

et le tour est joué !

Et nous avons le même principe par quantité



A partir de cet exemple je vous laisse adapter vos propres graphiques issus d'un TCD
 

Pièces jointes

  • LAB_STOCK.V0.06.xlsm
    48.3 KB · Affichages: 2

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…