Correction de code création graphique

Bonjour,

Je viens solliciter l'aide de la communauté. :)

Dans le fichier anonymisé ci-joint, j'ai une macro qui devrait créer des raphiques automatiquement à partir de 2 plages de données. Malheureusement le code se grippe et je ne parvient pas à trouver la solution pour finir la tâche.

J'aimerais donc créer des graphiques qui contiendrait toujours la même série et changer à chaque fois la 2ème série en la mettant sur un axe secondaire. Le code bloque au niveau de :

        ' Définir la plage de données du graphique (dates et valeurs du premier tableau)
        Set chartDataRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastRow, 2))
        chart.SetSourceData chartDataRange

Voici le code complet :

Sub CreerGraphiques()
    Dim wsData As Worksheet
    Dim wsGraph As Worksheet
    Dim chartIndex As Integer
    Dim lastRow As Long
    Dim lastCol As Long
    Dim chartDataRange As Range
    Dim chartSeriesRange As Range
    Dim chart As ChartObject

    ' Référence à la feuille de données
    Set wsData = ThisWorkbook.Sheets("Data")

    ' Référence à la feuille de graphiques (créer si elle n'existe pas)
    On Error Resume Next
    Set wsGraph = ThisWorkbook.Sheets("Graph")
    On Error GoTo 0

    If wsGraph Is Nothing Then
        Set wsGraph = Sheets.Add(After:=Sheets(Sheets.Count))
        wsGraph.Name = "Graph"
    End If

    ' Supprimer les graphiques existants sur la feuille Graph
    wsGraph.ChartObjects.Delete

    ' Trouver la dernière ligne et la dernière colonne du premier tableau
    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column

    ' Parcourir chaque colonne du deuxième tableau à partir de la colonne F
    For colIndex = 6 To wsData.Columns.Count
        ' Créer un nouveau graphique sur la feuille Graph
        Set chart = wsGraph.ChartObjects.Add(Left:=10 + (colIndex - 6) * 300, Width:=300, Top:=10, Height:=300)

        ' Définir la plage de données du graphique (dates et valeurs du premier tableau)
        Set chartDataRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastRow, 2))
        chart.SetSourceData chartDataRange

        ' Ajouter une série pour la colonne actuelle du deuxième tableau
        Set chartSeriesRange = wsData.Range(wsData.Cells(1, colIndex), wsData.Cells(lastRow, colIndex))
        With chart.chart.SeriesCollection.NewSeries
            .Values = chartSeriesRange
            .XValues = chartDataRange.Columns(1)
            .AxisGroup = 2 ' Utiliser l'axe secondaire
        End With

        ' Ajouter un titre pour la série basé sur l'en-tête de colonne
        chart.chart.FullSeriesCollection(colIndex - 5).Name = wsData.Cells(1, colIndex).Value
    Next colIndex
End Sub

Merci à celui ou celle qui voudra se pencher sur la question !

Bonne journée,

Vbabeginner

1test-vba.xlsm (161.25 Ko)

bonjour VBABEGINNER,

certains mots sont réservé et vous ne pouvez pas les utiliser, par exemple votre nouveau graphique, vous ne pouvez pas l'appeler "chart", mais vous pouvez l'appeler "chart1"

5test-vba.xlsm (286.37 Ko)

Bonjour,

Merci, effectivement je n'y avais pas pensé !

Dans la correction du code que vous avez effectuée il n'y a qu'une série et pas 2 comme prévues initialement (et donc pas de de deuxième axes non plus). Est-ce que possible de les conserver ou pas ?

Un grand merci pour votre retour !

Bonen journée,

VBabeginner.

Re,

J'ai pu résoudre le problème. Il était dû au fait que l'entete de la colonne A était inclu dans la série. Je l'ai modifié ainsi :

Set chartDataRange = wsData.Range(wsData.Cells(2, 1), wsData.Cells(lastRow, 2)) ' Exclure la première ligne

et ca marche très bien.

Un très grand merci !!!

Rechercher des sujets similaires à "correction code creation graphique"