Création de diagrammes par VBA

Bonjour à tous,

Je rencontre un problème avec un code en deux étapes que j'ai développé. La première partie fonctionne correctement : il génère des diagrammes à partir des informations présentes dans ma feuille "FXX - Trame". Cette étape est gérée par la fonction CréerTousLesDiagrammesEtGérerClics, et tout se passe bien.

Cependant, pour la deuxième étape, lorsque je clique sur un élément dans le diagramme "discipline", je souhaite générer un autre diagramme basé sur les phases de cette discipline. Mais je reçois un message d'erreur indiquant : "Aucune phase n'a été trouvée pour cette discipline". Ce qui me semble incohérent, car des phases existent bel et bien pour chaque discipline.

Le problème est donc que, bien que des phases soient associées à chaque discipline, le code ne semble pas les trouver lorsque je clique sur le diagramme.

Si quelqu'un a une idée de ce qui pourrait poser problème, je suis preneur de vos suggestions.

Merci d'avance !

Sub CréerTousLesDiagrammesEtGérerClics()

    Dim dict As Object
    Dim lastRowDict As Long, i As Long, j As Long, k As Long
    Dim chartObj As ChartObject
    Dim rng As Range
    Dim data As Variant, labels As Variant
    Dim valeur As String, valeurArr() As String
    Dim colonne As Long, titre As String, nomDiagramme As String

    ' Définir les feuilles
    Set wsDict = ThisWorkbook.Sheets("FXX - Trame")
    Set wsDonnées = ThisWorkbook.Sheets("FeuilleDonnée")
    Set wsDiagramme = ThisWorkbook.Sheets("Diagramme Attributs")
    Set wsCorrelation = ThisWorkbook.Sheets("Corelation diagramme")

    ' Supprimer d'anciens graphiques dans la feuille "Corelation diagramme"
    For Each chartObj In wsCorrelation.ChartObjects
        chartObj.Delete
    Next chartObj

    ' Liste des colonnes, titres et noms de diagrammes
    Dim colonnes As Variant, titres As Variant, nomsDiagrammes As Variant
    colonnes = Array(11, 10, 12, 13, 14, 15, 18, 19) ' Colonnes K, J, L, M, O, N, R, R
    titres = Array("Disciplines", "Systèmes", "Sous-Disciplines", "Niveau de Preuve", "Famille de produit", "Type de Produit", "Phase", "Rubriques")
    nomsDiagrammes = Array("Répartition des Disciplines", "Répartition des Systèmes", "Répartition des Sous-disciplines", "Répartition des Niveaux de Preuve", "Répartition des Familles de produit", "Répartition des Types de Produit", "Répartition des Phases", "Répartition des Rubriques")

    ' Position initiale des graphiques
    Dim chartLeft As Double, chartTop As Double
    chartLeft = 5
    chartTop = 5

    ' Boucle pour chaque type de diagramme
    For k = LBound(colonnes) To UBound(colonnes)
        colonne = colonnes(k)
        titre = titres(k)
        nomDiagramme = nomsDiagrammes(k)

        ' Initialiser le dictionnaire pour stocker les fréquences
        Set dict = CreateObject("Scripting.Dictionary")

        ' Trouver la dernière ligne du dictionnaire
        lastRowDict = wsDict.Cells(wsDict.Rows.Count, colonne).End(xlUp).Row

        ' Lire les données du dictionnaire
        For i = 9 To lastRowDict
            valeur = Trim(wsDict.Cells(i, colonne).Value)
            If valeur <> "" Then
                valeurArr = Split(valeur, ",")
                For j = LBound(valeurArr) To UBound(valeurArr)
                    valeur = Trim(valeurArr(j))
                    If Not dict.exists(valeur) Then
                        dict.Add valeur, 1
                    Else
                        dict(valeur) = dict(valeur) + 1
                    End If
                Next j
            End If
        Next i

        ' Vérifier si des données existent pour ce diagramme
        If dict.Count > 0 Then
            ' Mettre les données dans des plages pour les camemberts
            Set rng = wsDonnées.Cells(2, k * 3 + 1).Resize(dict.Count, 2)

            ' Ajouter les données à "FeuilleDonnée"
            wsDonnées.Cells(1, k * 3 + 1).Value = titre
            wsDonnées.Cells(1, k * 3 + 2).Value = "Occurrences"

            ' Remplir les tableaux
            data = dict.keys
            labels = dict.items

            ' Remplir les données dans les cellules
            For i = 0 To dict.Count - 1
                rng.Cells(i + 1, 1).Value = data(i)
                rng.Cells(i + 1, 2).Value = labels(i)
            Next i

            ' Créer le camembert des disciplines
            On Error Resume Next ' Ignorer les erreurs pour passer au diagramme suivant
            Set chartObj = wsDiagramme.ChartObjects.Add(Left:=chartLeft, Top:=chartTop, Width:=300, Height:=300)
            If Not chartObj Is Nothing Then
                With chartObj.chart
                    .SetSourceData Source:=rng
                    .ChartType = xlPie
                    .HasTitle = True
                    .ChartTitle.Text = nomDiagramme
                    .ApplyDataLabels xlDataLabelsShowValue
                End With

                ' Lier l'événement de clic au graphique des disciplines
                If k = 0 Then ' Seulement pour le graphique des disciplines
                    chartObj.chart.Parent.OnAction = "GérerClicDiscipline"
                End If

                ' Décaler la position pour le prochain graphique
                chartLeft = chartLeft + 310
                If chartLeft > 1000 Then ' Si on dépasse une certaine largeur, passer à la ligne suivante
                    chartLeft = 5
                    chartTop = chartTop + 310
                End If
            End If
            On Error GoTo 0 ' Réactiver la gestion des erreurs
        Else
            ' Aucune donnée pour ce diagramme
            Debug.Print "Aucune donnée pour : " & nomDiagramme
        End If
    Next k

    MsgBox "Tous les diagrammes ont été traités avec succès !", vbInformation
End Sub
Public Sub GérerClicDiscipline()
    Dim disciplineCliquee As String
    Dim wsDict As Worksheet
    Dim wsCorrelation As Worksheet
    Dim lastRowDict As Long, i As Long, j As Long
    Dim chartObj As ChartObject
    Dim dict As Object
    Dim data As Variant, labels As Variant
    Dim rng As Range
    Dim colonne As Long
    Dim phasesCell As String
    Dim disciplinesCell As String
    Dim disciplineArr() As String
    Dim phaseArr() As String
    Dim discipline As String
    Dim phase As String

    ' Récupérer la discipline cliquée
    disciplineCliquee = Application.Caller

    ' Définir les feuilles
    Set wsDict = ThisWorkbook.Sheets("FXX - Trame")
    Set wsCorrelation = ThisWorkbook.Sheets("Corelation diagramme")

    ' Initialiser le dictionnaire pour les phases
    Set dict = CreateObject("Scripting.Dictionary")

    ' Définir la colonne des phases (colonne 18 "R")
    colonne = 18  ' Colonne R pour les phases

    ' Trouver la dernière ligne de données dans la feuille "FEE - Trame"
    lastRowDict = wsDict.Cells(wsDict.Rows.Count, 11).End(xlUp).Row  ' Colonne K (discipline)

    ' Lire les données pour les disciplines et les phases
    For i = 9 To lastRowDict
        ' Récupérer les cellules de discipline et de phase
        disciplinesCell = Trim(wsDict.Cells(i, 11).Value)  ' Colonne K (Disciplines)
        phasesCell = Trim(wsDict.Cells(i, colonne).Value)  ' Colonne R (Phases)

        ' Scinder les disciplines et les phases en tableaux (séparés par des virgules)
        disciplineArr = Split(disciplinesCell, ",")
        phaseArr = Split(phasesCell, ",")

        ' Comparer chaque discipline dans la cellule avec la discipline cliquée
        For j = LBound(disciplineArr) To UBound(disciplineArr)
            discipline = Trim(disciplineArr(j))  ' Discipline dans la cellule
            ' Si la discipline correspond à la discipline cliquée
            If StrComp(discipline, disciplineCliquee, vbTextCompare) = 0 Then
                ' Ajouter chaque phase dans le dictionnaire
                For k = LBound(phaseArr) To UBound(phaseArr)
                    phase = Trim(phaseArr(k))  ' Phase dans la cellule
                    If Not dict.exists(phase) Then
                        dict.Add phase, 1
                    Else
                        dict(phase) = dict(phase) + 1
                    End If
                Next k
            End If
        Next j
    Next i

    ' Vérifier si des phases ont été trouvées
    If dict.Count > 0 Then
        ' Ajouter les données dans la feuille "Corelation diagramme"
        Set rng = wsCorrelation.Cells(2, 1).Resize(dict.Count, 2)

        ' Remplir les tableaux avec les données filtrées
        data = dict.keys
        labels = dict.items
        For i = 0 To dict.Count - 1
            rng.Cells(i + 1, 1).Value = data(i)
            rng.Cells(i + 1, 2).Value = labels(i)
        Next i

        ' Créer le camembert des phases
        Set chartObj = wsCorrelation.ChartObjects.Add(Left:=5, Top:=5, Width:=300, Height:=300)
        With chartObj.chart
            .SetSourceData Source:=rng
            .ChartType = xlPie
            .HasTitle = True
            .ChartTitle.Text = "Phases pour la discipline: " & disciplineCliquee
            .ApplyDataLabels xlDataLabelsShowValue
        End With
    Else
        MsgBox "Aucune phase n'a été trouvée pour cette discipline."
    End If
End Sub

Bonjour,

Avez-vous vérifié, en exécution pas à pas par exemple, que Application.Caller vous renvoie bien le nom de la discipline ?

Sinon, ce serait utile de joindre un fichier pour tester & regarder l'exécution. Merci.

Yes voici un fichier d'exemple :

Comme je vous le disais, Application.Caller renvoie le nom du diagramme, par exemple "Chart1". Et ce nom n'a aucune correspondance avec vos disciplines.

Vous devriez renommer vos diagrammes pour correspondre aux disciplines.

A moins que je pense a quelque chose, si vous voulez récupérer un segment de votre diagramme, dans l'exemple "b" par exemple, ce n'est pas possible avec Application.Caller. Vous ne pourrez récupérer que la forme/shape content le diagramme.

Il faudrait faire 4 boutons correpondant aux 4 segments par exemple. Ou des cellules, un Userform… Mais on ne peut pas récupérer le clic sur un élément de diagramme désolé.