Wasserfall-Diagramme Grafikfehler bei erstellung mit VBA
24.01.2024 17:09:18
Luise
mein letzter Beitrag zu dem Thema wurde leider Archiviert: https://www.herber.de/forum/archiv/1960to1964/1960651_VBA_Export_WasserfallDiagramme.html#1960651
Ich habe aktuell das Problem, dass wenn ich mit VBA Wasserfalldiagramme erstelle, dann ist ab und zu die Formatierung/Darstellung kaputt.
Bei mehrmaligem Durchlauf des Codes mit den selben Testdaten treten die Fehler mal auf und mal nicht. Es trett immer wieder unterschiedliche Fehler auf so, dass z.B. Doppelte Eurozeichen zu sehen sind oder auch positive Ganzzahlen so dargestellt werden -14,24,00 , wobei die Zahl in den Rohdaten eigentlich 1424 ist.
Meistens jedoch treten eher leichtere Fehler auf wie z.B. Fehlende Eurozeichen oder Ganzzahlen mit ,00 hinten dran.
Die Fehler beziehen sich aber immer auf die Beschriftung des Diagramms.
Das Problem tritt unabhäng davon auf, ob ich Office 2016 oder Office 365 nutze.
Hier ein Beispiel wie das Diagramm mit den Testdaten aussieht:
Der Code sieht aktuell Folgendermaßen aus:
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
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)
.FullSeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(0, 176, 240)
.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
End With
DiagramPrintAndExport = True
Exit Function
ERR_MakeDiagramm:
DiagramPrintAndExport = False
End Function
Hat jemand bisher schon einmal so einen Fehler gehabt? Wie könnte ich ihn Lösen.
Freundliche Grüße
Luise