Diagrammgröße unter Bedingung

Liebe Excelgemeinde,
ich hätte ein kleines Problem, bei dem ihr mir sicherlich helfen könnt. Ich möchte auf einem Tabellenblatt die Größe von mehreren Diagrammen per VBA verändern. Wie ihr im angehängten Dokument sehen könnt, habe ich drei Diagramme in diesem Tabellenblatt mit vier, fünf und sechs Datenreihen bzw. Fragen, die ausgewertet werden sollen. Das ist die Ausgangsituation.
Im nächsten Schritt wird ein Makro (das ich hier aus Gründen der Einfachheit nicht eingebaut habe) ausgeführt, das die Zeilen löscht, wenn die betreffende Frage nicht ausgewertet werden soll. Es kann also sein, dass z.B. in Diagramm 1 nur noch eine Frage ausgewertet werden soll. Problem: Das Diagramm sieht dann verzerrt aus, da die Balken zu dick werden. Daher möchte ich die Diagrammgröße ensprechend per VBA anpassen, je nach dem, wie viele Kategorien/Fragen nach dem ausgeführten Makro noch enthalten sind.
Um es einfach zu halten, sollen für alle drei Diagramme die gleichen Regeln gelten. Beispiel:
Bei drei Fragen im Diagramm: Diagrammhöhe x und Höhe der Zeichnungsfläche x
Bei zwei Fragen im Diagramm: Diagrammhöhe y und Höhe der Zeichnungsfläche y
Bekommt das jemand für mich hin? Das wäre großartig! Meine VBA Kenntnisse sind stark limitiert, daher habe ich keine Vorarbeit leisten können.
Vielen Dank schon einmal!
Gruß Florian
https://www.herber.de/bbs/user/88704.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zeilen_löschen() Dim lz As Long, t As Long Dim chrDiagramm As ChartObject Dim lngPunkte As Long Application.ScreenUpdating = False lz = Cells(Rows.Count, 1).End(xlUp).Rows.Row For t = lz To 2 Step -1 If Cells(t, 2).Text = "#BEZUG!" Then Rows(t).Delete shift:=xlUp End If Next t For Each chrDiagramm In Worksheets("Grafiken").ChartObjects With chrDiagramm.Chart lngPunkte = .SeriesCollection(1).Points.Count .ChartArea.Height = 367 * lngPunkte / 6 .PlotArea.Height = 307 * lngPunkte / 6 End With Next chrDiagramm Application.ScreenUpdating = True End Sub

Hallo Beverly,
der Code läuft ohne Fehler durch, allerdings ist er noch ein wenig zu unflexibel. Bei drei Datenreihen pro Chart sieht es gut aus, bei nur einer Datenreihe hingegen nicht. Kann man den Code noch über If-Bedingungen so gestalten, dass man für jede Anzahl an Datenreihen eine Vorgabe macht (siehe meinen ersten Post)? Also irgendwie so:
If lngPunkte = 1 Then
.ChartArea.Height = x & .PlotArea.Height = x
If lngPunkte = 2 Then
.ChartArea.Height = y & .PlotArea.Height = y
Und eine zweite Frage: Kann man im Code noch spezifizieren, welche Diagramme genau von dem Makro betroffen sein sollen? Bisher werden ja alle angesprochen. Wenn ich aber z.B. Diagramm2 nicht dabei haben möchte, wie kann man dieses davon ausschließen?
Bin leider nicht kompetent genug, das umzusetzen... Sorry. Aber du hast mir schon einmal sehr geholfen!
Viele Grüße
Florian

For Each chrDiagramm In Worksheets("Grafiken").ChartObjects With chrDiagramm.Chart lngPunkte = .SeriesCollection(1).Points.Count Select Case lngPunkte Case 1 ' .ChartArea.Height = ... ' .PlotArea.Height = ... Case 2 ' .ChartArea.Height = ... ' .PlotArea.Height = ... Case 3 ' .ChartArea.Height = ... ' .PlotArea.Height = ... End Select End With

For Each chrDiagramm In Worksheets("Grafiken").ChartObjects If chrDiagramm.Name "Chart 1" Then With chrDiagramm.Chart lngPunkte = .SeriesCollection(1).Points.Count Select Case lngPunkte Case 1 ' .ChartArea.Height = ... ' .PlotArea.Height = ... Case 2 ' .ChartArea.Height = ... ' .PlotArea.Height = ... Case 3 ' .ChartArea.Height = ... ' .PlotArea.Height = ... End Select End With End If Next chrDiagramm

Sub Makro2() For Each chrDiagramm In Worksheets("Grafiken").ChartObjects If chrDiagramm.Name "Diagramm1" And chrDiagramm.Name "Diagramm2" Then With chrDiagramm.Chart lngPunkte = .SeriesCollection(1).Points.Count If lngPunkte = 1 Then .ChartArea.Height = 120 .PlotArea.Top = 25 .PlotArea.Height = 70 .Legend.Top = 95 .Legend.Height = 25 End If If lngPunkte = 2 Then .ChartArea.Height = 160 .PlotArea.Top = 25 .PlotArea.Height = 110 .Legend.Top = 135 .Legend.Height = 25 End If If lngPunkte = 3 Then .ChartArea.Height = 200 .PlotArea.Top = 25 .PlotArea.Height = 150 .Legend.Top = 175 .Legend.Height = 25 End If If lngPunkte = 4 Then .ChartArea.Height = 240 .PlotArea.Top = 25 .PlotArea.Height = 190 .Legend.Top = 215 .Legend.Height = 25 End If End With End If Next chrDiagramm Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread