VBA Chart maximale Länge Diagrammdatenbereich
15.12.2012 15:45:19
Philipp
ich habe ein kleines Problem bei der Erstellung von dynamischen Charts in Excel VBA.
Ich habe in Excel eine Reihe an Tabellenblätter (Name) für das ich jeweils in weiteres Tabellenblatt (Name-Chart) erstelle. In das Name-Chart Blatt soll dann jeweils der Inhalt von den Blättern Name grafisch dargestellt werden.
Hierzu habe ich mir auch eine kleine Funktion geschrieben.
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
und
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
Bei ALLEN Tabellenblätter, deren Bezeichnung länger ist tritt ein Fehler beim Erstellen des Diagramms auf. Daher habe ich einmal händisch die Namen verkürzt und siehe da... es hat funktioniert.Anscheinend kann die Funktion
ActiveChart.SetSourceData Source:=Range(ChartBereich)
nur eine beschränkte Länge aufnehmen.Leider ist es für die Endanwendung nicht möglich, die Länge der Tabellenblatt Bezeichnung zu verkürzen.
Über eine Lösungsidee wäre ich sehr froh :)
LG,
Philipp