web-dev-qa-db-fra.com

Script VBA Excel pour ajouter dynamiquement des séries au graphique

J'essaie d'ajouter dynamiquement plusieurs séries à un graphique en courbes. Je ne sais pas d'avance combien de séries il y a donc ça doit être dynamique. Ce que j'ai trouvé mais qui ne fonctionne pas est le suivant:

La feuille ActiveSheet (ou Sheets ("Data")) a des lignes de C14 à Cend contenant les XValues ​​et colonnes de E14: Eend jusqu'à R14: Rend où "end" marque la dernière ligne de données comme déterminé par la colonne C. Les noms de série sont stockés dans la ligne 9. Les valeurs XV sont les mêmes pour toutes les séries.

Mon gros problème est que je ne peux pas trouver un moyen d'ajouter dynamiquement toutes les colonnes de données en tant que séries à mon graphique avec le nom respectif. Je ne suis pas un expert en VBA, alors soyez gentil. J'ai déjà lu diverses sources et essayé de nombreux scripts, aucun ne semble fonctionner. Le catalogue d'objets a été un peu d'une aide, mais mon problème persiste.

Sub MakeChart()
Dim LastColumn As Long
Dim LastRow As Long
Dim i As Integer
Dim u As Integer
Dim NameRng As String
Dim CountsRng As Range
Dim xRng As Range

    LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column
    ColumnCount = LastColumn - 4
    LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
'   Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow)

    Charts.Add
    With ActiveChart
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Text = "Test"
    End With

    For i = 1 To ColumnCount
        u = i + 4
       NameRng = Sheets("Data").Range("R9:C" & u).Value
       Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")
       Set CountsRng = Sheets("Data").Range("R14:C" & u, "R" & LastRow & ":C" & u)
'      Debug.Print ("CountsRng: R14:C" & u & ", R" & LastRow & ":C" & u & " NameRng: " & NameRng & " xRng: R14:C3 , R" & LastRow & ":C3")
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(i).XValues = xRng
            ActiveChart.SeriesCollection(i).Values = CountsRng
            ActiveChart.SeriesCollection(i).Name = NameRng
    Next i

End Sub
excelvbachartsdynamically-generated
8
chross

merci pour l'aide. J'ai résolu le problème. Il semble que j'ai complètement gâché la notation de la plage de cellules. Vous ne pouvez pas utiliser

Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")

Mais plutôt utiliser

Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))

En outre, l'utilisation de Charts.Add n'a pas beaucoup aidé, car Excel tente de trouver automatiquement les plages correctes pour toutes les séries et les ajoute, ce qui donne un graphique complètement foiré. Une meilleure façon était d'utiliser

Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)

Comme cela va créer un graphique complètement vide auquel vous pouvez ajouter votre propre série

Voici le code complet et fonctionnel pour toute personne intéressée:

Sub MakeChart()
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim ColumnCount As Long
    LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
    LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column
    ColumnCount = LastColumn - 4
    Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow)

    Dim wsChart As Worksheet
    Set wsChart = Sheets(1)
    wsChart.Activate
    Dim ChartObj As ChartObject
    Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)
    ChartObj.chart.ChartType = xlLineMarkers

    Dim i As Integer
    Dim u As Integer
    Dim NameRng As String
    Dim xRng As Range
    Dim CountsRng As Range

    For i = 1 To ColumnCount
        u = i + 4

        With Sheets("Data")
            NameRng = .Cells(9, u).Value
            Set CountsRng = .Range(.Cells(14, u), .Cells(LastRow, u))
            Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))
            Debug.Print "--" & i & "--" & u & "--"
            Debug.Print "x Range: " & xRng.Address
            Debug.Print "Name Range: " & .Cells(9, u).Address
            Debug.Print "Value Range: " & CountsRng.Address
        End With

        'Set ChartSeries = ChartObj.chart.SeriesCollection.NewSeries
        'With ActiveChart.SeriesCollection.NewSeries
        With ChartObj.chart.SeriesCollection.NewSeries
            .XValues = xRng
            .Values = CountsRng
            .Name = NameRng
        End With
        'Set xRng = Nothing
        'Set CountsRng = Nothing
        'NameRng = ""
    Next i

    'ChartObj.Activate
    With ChartObj.chart
        .SetElement (msoElementLegendBottom)
        .Axes(xlValue).MajorUnit = 1
        .Axes(xlValue).MinorUnit = 0.5
        .Axes(xlValue).MinorTickMark = xlOutside
        '.Axes(xlCategory).TickLabels.NumberFormat = "#,##000"
        .Axes(xlCategory).TickLabels.NumberFormat = "#,##0"
        '.Location Where:=xlLocationAsObject, Name:="Plot"
    End With

End Sub
13
chross

exemple de code

Sub InsertChart()

    Dim first As Long, last As Long
    first = 10
    last = 20

    Dim wsChart As Worksheet
    Set wsChart = Sheets(1)

    wsChart.Activate
    wsChart.Shapes.AddChart.Select

    Dim chart As chart
    Set chart = ActiveChart
    chart.ChartType = xlXYScatter

    ' adding series
    chart.SeriesCollection.NewSeries
    chart.SeriesCollection(1).Name = "series name"
    chart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!$A$" & first & ":$A$" & last
    chart.SeriesCollection(1).Values = "=" & ActiveSheet.Name & "!$B$" & first & ":$B$" & last

End Sub

vous pouvez parcourir la plage et continuer à ajouter plus de séries

6
user2140173