VBA Chart maximale Länge Diagrammdatenbereich

Sub Diagramm(aktVerein As String, AktEbene As Integer, PrevEbene As Integer)
Dim ChartBereich As String
Dim ChartBereichAVG As String
Dim AnzahlZeilen As Integer
Dim i As Integer
Dim ChartPositionTop As Integer
Dim currentTitel As String
currentTitel = ""
ChartPositionTop = 0
AnzahlZeilen = Worksheets(aktVerein).Cells(Rows.Count, 10).End(xlUp).Row
For i = 2 To AnzahlZeilen
If Worksheets(aktVerein).Cells(i, AktEbene)  "" Then
ChartBereich = ChartBereich & "'" & Worksheets(aktVerein).Name & "'!" & Cells(i,  _
AktEbene).Address & "," & "'" & Worksheets(aktVerein).Name & "'!" & Cells(i, 10).Address & ","
ChartBereichAVG = ChartBereichAVG & "'" & Worksheets(aktVerein).Name & "'!" & Cells( _
i, 11).Address & ","
End If
If Worksheets(aktVerein).Cells(i, PrevEbene)  "" And ChartBereich  "" Then
ChartPositionTop = ChartPositionTop + 320
Call createChartFromArea(ChartBereich, ChartBereichAVG, currentTitel, aktVerein,  _
AktEbene, ChartPositionTop)
ChartPositionTop = ChartPositionTop + 320
ChartBereich = ""
ChartBereichAVG = ""
End If
If Worksheets(aktVerein).Cells(i, PrevEbene)  "" And ChartBereich = "" Then
currentTitel = Worksheets(aktVerein).Cells(i, PrevEbene)
End If
Next i
Call createChartFromArea(ChartBereich, ChartBereichAVG, currentTitel, aktVerein, AktEbene,  _
ChartPositionTop)
End Sub

Sub createChartFromArea(ChartBereich As String, ChartBereichAVG As String, diagramTitle As  _
String, aktVerein As String, AktEbene As Integer, ChartPositionTop As Integer)
On Error GoTo charterror:
' Letzte "," abschneiden
ChartBereich = Left(ChartBereich, Len(ChartBereich) - 1)
ChartBereichAVG = Left(ChartBereichAVG, Len(ChartBereichAVG) - 1)
'Chart erstellen
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range(ChartBereich)
'Average Spalte einfügen
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Values = Range(ChartBereichAVG)
'Chart formatieren
ActiveChart.ChartStyle = 32
ActiveChart.SetElement (msoElementLegendBottom)
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
If AktEbene = 2 Then
ActiveChart.ChartTitle.Text = Worksheets(aktVerein).Cells(1, AktEbene)
Else
'ActiveChart.ChartTitle.Text = Worksheets(aktVerein).Cells(2, 1) & " - " & diagramTitle
ActiveChart.ChartTitle.Text = diagramTitle & " - " & Worksheets(aktVerein).Cells(1,  _
AktEbene)
End If
ActiveChart.SeriesCollection(1).Name = Worksheets(aktVerein).Cells(2, 1)
ActiveChart.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
ActiveChart.SeriesCollection(2).Name = "Ø"
ActiveChart.SeriesCollection(2).DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
'Chart positionieren
With ActiveChart.Parent
.Width = 400
.Height = 300
.Top = 5 + ChartPositionTop
.Left = 5
End With
Exit Sub
charterror:
MsgBox aktVerein & " " & diagramTitle
End Sub

ActiveChart.SetSourceData Source:=Range(ChartBereich)