100 Balkendiagramme sauber auf Excelseiten positionieren?
12.06.2025 15:27:25
widdi
ich habe im Forum schon gesucht und etwas gefunden, was mich jetzt nicht weiter gebracht hat (aus 2019: https://www.herber.de/forum/archiv/1684to1688/1687066_Grafiken_per_VBA_kopieren_Top_Eigenschaft.html#1)
Folgendes Problem:
Ich habe eine Tabelle mit 6 Wertspalten (01:T1 - voll und ganz, großteils, weder noch, weniger, gar nicht, Durchschnitt) und 2 Beschreibungsfeldern (L1, M1, Chart-Titel und Subtitel)
Ich bekomme eine Tabelle mit 100 Einträgen (N2:T101). (N enthält die X-Achsentexte)
Aus diesen möchte ich Grafiken erstellen. Dies funktioniert mit folgendem Code recht gut (Beispiel hat nur 9 Grafiken, Screenshot unten)
Sub Erstellen()
For i = 0 To 8
Dim chartObj As ChartObject
If i = 0 Then
Set chartObj = ActiveSheet.ChartObjects.Add(0, 0, 680, 370)
Else
Set chartObj = ActiveSheet.ChartObjects.Add(0, (473 * i - 2 * i), 680, 370)
End If
With chartObj.Chart
.ChartType = xlColumnClustered
.SetSourceData Source:=Range("O" & i + 2 & ":T" & i + 2)
.HasTitle = True
.ChartTitle.Text = Range("L1").Value & vbLf & Range("M1").Value
.ChartTitle.Characters(1, InStr(.ChartTitle.Text, vbLf) - 1).Font.Size = 16
.ChartTitle.Characters(InStr(.ChartTitle.Text, vbLf) + 1, Len(.ChartTitle.Text) - InStr(.ChartTitle.Text, vbLf)).Font.Size = 12
.Axes(xlCategory).TickLabels.Font.Size = 8
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = Range("N" & i + 2).Value
.Axes(xlCategory).CategoryNames = Range("O1:T1").Value
.Legend.Position = xlLegendPositionBottom
.Legend.Delete ' Legende wird ausgeblendet, da bei verschiedenen Farben die Legenden mit den Werten belegt werden und dann die Darstellung doppelt wäre
For j = 1 To .SeriesCollection.Count
.SeriesCollection(j).Points(6).Interior.Color = RGB(0, 206, 209) 'färbt die "Durchschnittsspalte" anders ein
' .SeriesCollection(j).Name = Range("N" & i + 2).Value ' das kann alternativ zum Achsentitel X genommen werden, wenn alle die gleiche Farbe haben
' dann wird die Legende als Spaltentitel eingesetzt
Next j
.ChartGroups(1).GapWidth = 120 ' ändert die Spaltenbreiten. Es gibt aber minimale und maximale Grenzen.
.ChartGroups(1).Overlap = 70 ' über "SeriesCollection" funktionierte die Definition nicht
End With
Range("B" & (i * 33 + 30)).Value = "FußZeile 1"
Range("B" & (i * 33 + 31)).Value = "FußZeile 2"
Next i
End Sub
Mein Problem ist jetzt folgendes:
Ursprünglich hatte ich statt dem "if then else" oben folgende Definition:
Set chartObj = ActiveSheet.ChartObjects.Add(Left:=Range("A" & (i * 33 + 1)).Left, Width:=685, Top:=Range("A" & (i * 33 + 1)).Top, Height:=470)Wenn ich mir die Seitenansicht ansehe, bekomme ich ja die "Seitenumbrüche" angezeigt. Und bei einer Standard-Excel-Seite waren eben 33 Zeilen bei mir eine Seite. Das heisst Zeile 1, 34, 67, 100,... sind immer auf einer neuen Seite und das "Range(ZELLE).Top" hätte mir eigtl. den oberen Rand geben müssen. Aber das ganze rutscht nach unten.
Also dachte ich mir - ich nehme fixe Werte und habe eben eine Höhe von 437 bestimmt. Aber auch da.. verrutschen. Darauf hin hing ich noch nach Schleifendurchlauf ein "-i" an, bzw. jetzt "-2*i". Was soll ich sagen: Es wird besser - aber passt eben nicht.
Was mich halt irritiert. Schon der Wert RANGE("A100").Top wird ursprünglich falsch bestimmt. Aber auch wenn ich das wieder einsetze und Minus i oder Minus 2i rechne... schon bei 9 Grafiken habe trotz des Korrekturfaktors -2i einen Versatz.
Klar könnte ich nach 10 Bildern ein neues Tabellenblatt beginnen und dann die Grafiken zusammen als PDF exportieren. Aber das wäre nur eine Krücke. Wie kann ich sauber die Zellen"oberkante" oder den Seitenumbruch referenzieren, ohne irgendwelche Korrekturen zu berechnen. Vor allem, da ja auch "-2i" nicht sauber trifft (und immer mehr korrigiert, 2, 4, 6, 8, 10,... bis zu 200). beim Screnshot heisst das also "-18"
Achja... "Left" ist egal. das geht. Ich habe nur einen Höhenversatz.
Auch wenn ich die 4 Variablem mit "Position" statt Zuweisung .Add(links, oben, breite, höhe) angebe.... kein Unterschied.
Danke für n paar Ideen.
Anzeige
