VBA Export Wasserfall-Diagramme
16.01.2024 10:22:42
Luise
ich habe einen VBA-Code geschrieben der mir aus Zeilen einer Tabelle zu Wasserfall-Diagramme generiert, diese werden dann als PNG-Datei exportiert. Danach wird das gerade erstellte Wasserfalldiagramm auf einen eigenen Reiter verschoben.
Das Problem ist aber, dass beim Export der Diagramme Fehler in der Formatierung entstehen.
Bei mehrfacher Verwendung der selben Daten mal Fehler auf und mal nicht und es sind eigentlich immer unterschiedliche Fehler.
Die Fehler Beziehen sich aber immer auf die Beschriftung des Diagramms.
Hier ein paar Beispiele:
Ich habe auch schon Fehler gehabt wo gar keine Beschriftung an den Säulen war oder doppelte Minuszeichen obwohl sich alle Zahlen im Positiven Bereich befinden.
Es gab auch schon Zahlen mit doppelten Komma obwohl ich nur Ganze Zahlen verwende.
Manchmal Fehlt auch die Beschriftung unten in Teilen oder Ganz, daher vermute ich nicht das es was mit der Formatierung der Zahlen in der Tabelle zu tun hat.
Ich habe schon versucht die Bilder als JPG zu exportieren, dies hat auch nichts gebracht.
Ist dieses Problem bekannt?
Liegt es am Wasserfall Diagramm?
Verwendete Testdaten:
Die Funktion DiagramRanges ist als nur für die Beispieldaten
Code:
Option Explicit
Sub DiagramRanges()
Dim lngCnt As Long
Dim strPath As String
Dim wsTest As Worksheet
' Speicherort für die Bilder:
strPath = "C:\Users\Username\DiagrammTest\"
Set wsTest = Sheets(1)
For lngCnt = 3 To 6
With wsTest
.Activate
If Not DiagramPrintAndExport( _
.Name, _
2, _
lngCnt, _
strPath) Then GoTo ERR_Test
End With
Next
wsTest.Move ThisWorkbook.Charts(1)
ERR_Test:
End Sub
Function DiagramPrintAndExport(strWkReadName As String, lngTitleRow As Long, lngSumRow As Long, strExportPath As String) As Boolean
Dim wsRead As Worksheet
Dim chtObj As Chart
Dim shpChart As Shape
Dim lngPoints As Long
Dim strDiaName As String
On Error GoTo ERR_MakeDiagramm
Set wsRead = ThisWorkbook.Worksheets(strWkReadName)
strDiaName = wsRead.Range("B" & lngSumRow)
'Legt den Bereich fest der als Diagramm dargestellt werden soll
wsRead.Range("$C$" & lngSumRow & ":$I$" & lngSumRow).Select
'Erstellt ein Wasserfall Diagramm
Set shpChart = wsRead.Shapes.AddChart2(395, xlWaterfall)
Set chtObj = shpChart.Chart
With chtObj
'Übergibt die Titel des Bereiches an die X-Achse des Diagramms
.FullSeriesCollection(1).XValues = _
"='" & strWkReadName & "'!$C$" & lngTitleRow & ":$I$" & lngTitleRow
'Führt allgemeine Formatierungen durch
.FullSeriesCollection(1).Points(7).IsTotal = True
.SetElement (msoElementLegendNone)
.SetElement (msoElementChartTitleNone)
'Formatiert die Daten im Diagramm Farbig
For lngPoints = 1 To 6
.FullSeriesCollection(1).Points(lngPoints).Format.Fill.ForeColor.RGB = RGB(0, 176, 240)
Next
.FullSeriesCollection(1).Points(7).Format.Fill.ForeColor.RGB = RGB(31, 78, 121)
'Definiert die größe des Diagramms
.ChartArea.Height = (13.3 / 2.54) * 72
.ChartArea.Width = (20.7 / 2.54) * 72
'Exportiert das Diagramm als PNG an den vorher Ausgewählten Ort
.Export strExportPath & strDiaName & ".png", "PNG"
'Verschiebt das Diagramm vom Reiter auf einen eigenen Diagrammreiter
.Location xlLocationAsNewSheet, strDiaName
End With
DiagramPrintAndExport = True
Exit Function
ERR_MakeDiagramm:
DiagramPrintAndExport = False
End Function
Gruß Luise
