Automatisch Diagramme in Excel anlegen

Function DiagrammAnlegen(ws, i)
    Dim curgem As Integer
    
    ' Konfiguration auslesen
    anz_gem = WorkSheets(ws).Range("G9").Value
    first_kz = WorkSheets(ws).Range("G10").Value
    last_kz = WorkSheets(ws).Range("G11").Value
    delta_gem = WorkSheets(ws).Range("G12").Value
        
    ' Chart anlegen und selektieren
    ActiveSheet.Shapes.AddChart.Select
        
    ' Mit dem Chart Dinge tun ...
    With ActiveChart
        ' ChartType festlegen
        .ChartType = xlLineMarkers
        
        ' Fuer alle Gemeinden durchgehen
        For curgem = 0 To anz_gem - 1
            ' Neue Datenserie anlegen
            .SeriesCollection.NewSeries
                
            With .SeriesCollection(curgem + 1)
                ' die Datenranges festlegen
                .name = "='" & ws & "'!$A$" & (first_kz - 2 + curgem * delta_gem)
                .Values = "='" & ws & "'!$C$" & (first_kz + i + curgem * delta_gem) & ":$V$" & (first_kz + i + curgem * delta_gem)
                .XValues = "='" & ws & "'!$C$19:$V$19"
        
                ' Aus dem 'Def'-Tabellenblatt eine Farbe auslesen
                Dim color, colorR, colorG, colorB As Integer
                colorR = WorkSheets("Def").Cells(4 + curgem, 2).Value
                colorG = WorkSheets("Def").Cells(4 + curgem, 3).Value
                colorB = WorkSheets("Def").Cells(4 + curgem, 4).Value
                color = RGB(colorR, colorG, colorB)
                
                ' Serienstil festlegen
                .MarkerStyle = 1
                .MarkerSize = 5
                .MarkerForegroundColor = color
                .MarkerBackgroundColor = color
                .Border.color = color
            End With
        Next
    
        ' Y-Achse konfigurieren
        .SetElement (msoElementPrimaryValueAxisTitleRotated)
        .Axes(xlValue, xlPrimary).AxisTitle.Text = "Euro pro Kopf"
    
        ' Chart-Titel anlegen
        .SetElement (msoElementChartTitleAboveChart)
        .ChartTitle.Text = WorkSheets(ws).Range("$B$" & first_kz + i) & " (" & WorkSheets(ws).Range("$A$" & first_kz + i) & ")"
        
        ' Legende formatieren
        With .Legend
            .Position = xlBottom
        End With
    
        ' PlotArea formatieren
        With .PlotArea
            .Interior.color = RGB(220, 220, 220)
        End With
        
        ' ChartArea formatieren
        With .ChartArea
            .Width = 370
            .Height = 300
        End With
    End With
    
    ' Rueckgabewert richtigsetzen
    Set DiagrammAnlegen = ActiveChart
End Function

Sub TabellenblattDiagramme()
    ' Abfragen, fuer welches Tabellenblatt wir Diagramme zeichnen sollen
    ws = Application.InputBox("Welches Tabellenblatt?", , ActiveSheet.name)
    ' Spalten
    cols = Application.InputBox("Wieviele Spalten?", , 3)
    
    ' Sheet anlegen, benennen und verschieben
    WorkSheets.Add.Select
    With ActiveSheet
        .Move After:=WorkSheets(ws)
        .name = ws & " Diagramme"
    End With
    
    ' Aus Tabelle die Konfiguration auslesen
    anz_gem = WorkSheets(ws).Range("G9").Value
    first_kz = WorkSheets(ws).Range("G10").Value
    last_kz = WorkSheets(ws).Range("G11").Value
    delta_gem = WorkSheets(ws).Range("G12").Value
        
    ' Alle Kennzahlen durchgehen
    For i = 0 To last_kz - first_kz
        ' und ein Diagramm anlegen
        Set ob = DiagrammAnlegen(ws, i)
           
        ' das Diagramm noch an die richtige Position verschieben
        With ob
            ob.ChartArea.Left = 10 + (i Mod cols) * 380
            ob.ChartArea.Top = 10 + Int(i / cols) * 310
        End With
    Next
End Sub