VBA Makro Diagrammgrößen

Private Sub Daten_ueber_die_Pflanzung() 'durch Häckchen setzten in Checkbox22 "Daten über die Pflanzung", einblenden der Kreisdiagramme With Application 'beschleunigt Berechnung .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With With ActiveSheet If .Shapes("Check Box 22").ControlFormat.Value = 1 Then .ChartObjects("Diagramm 23").Visible = True .ChartObjects("Diagramm 23").PlotArea.Width = 140 .ChartObjects("Diagramm 23").PlotArea.Height = 140 .ChartObjects("Diagramm 24").Visible = True .ChartObjects("Diagramm 24").PlotArea.Width = 140 .ChartObjects("Diagramm 24").PlotArea.Height = 140 .ChartObjects("Diagramm 25").Visible = True .ChartObjects("Diagramm 25").PlotArea.Width = 140 .ChartObjects("Diagramm 25").PlotArea.Height = 140 .ChartObjects("Diagramm 26").Visible = True .ChartObjects("Diagramm 26").PlotArea.Width = 140 .ChartObjects("Diagramm 26").PlotArea.Height = 140 .ChartObjects("Diagramm 27").Visible = True .ChartObjects("Diagramm 27").PlotArea.Width = 140 .ChartObjects("Diagramm 27").PlotArea.Height = 140 Else .ChartObjects("Diagramm 23").Visible = False .ChartObjects("Diagramm 24").Visible = False .ChartObjects("Diagramm 25").Visible = False .ChartObjects("Diagramm 26").Visible = False .ChartObjects("Diagramm 27").Visible = False End If End With With Application .EnableEvents = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo, Peter,
hier ein Lösungsversuch, wobei einige Veränderungen sich auf die wiederholt auftretenen Befehlsarten sich beziehen.


Private Sub Daten_ueber_die_Pflanzung()
'durch Häckchen setzten in Checkbox22 "Daten über die Pflanzung", einblenden der Kreisdiagramme
With Application 'beschleunigt Berechnung
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Dim diaName As String
'Möglcikeit, wenn Diagrammnummern nicht aufeinaderfolgend
'diaName = Array("Diagramm 23", "Diagramm 24", "Diagramm 25", _
'                "Diagramm 25", "Diagramm 26", "Diagramm 27")
Dim i As Integer
Dim objCh As ChartObject
Dim dwX As Integer, dwY As Integer
dwX = 200: dwY = 200
With ActiveSheet
If .Shapes("Check Box 22").ControlFormat.Value = 1 Then
For i = 23 To 27
With .Shapes("Diagramm " & i)
.Top = dwY * Int((i - 1) / 3)
.Left = dwX * (i - 3 * Int((i - 1) / 3) - 1)
.Width = dwX
.Height = dwY
End With
Set objCh = ActiveSheet.ChartObjects("Diagramm " & i)
With objCh
.Visible = True
With .Chart
.PlotArea.Left = 0.1 * dwX
.PlotArea.Top = 0.1 * dwY
.PlotArea.Width = 0.8 * dwX
.PlotArea.Height = 0.8 * dwY
End With
End With
Set objCh = Nothing
Next i
Else
For i = 23 To 27
.ChartObjects("Diagramm " & i).Visible = False
Next i
End If
End With
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Plotarea-Größen beziehen sich auf die ChartArea-Größe, die ich hier über .Shapes("Diagramm " & i) angesprochen habe. Das Objekt ChartArea ist Bestandteil des Objekts ActiveSheet.ChartObjects("Diagramm " & i) und könnte so auch in den entsprechenden With-Blocke eiingefügt werden:


Set objCh = ActiveSheet.ChartObjects("Diagramm " & i)
With objCh
.Visible = True
With .Chart
.ChartArea.Top = dwY * Int((i - 1) / 3)
.ChartArea.Left = dwX * (i - 3 * Int((i - 1) / 3) - 1)
.ChartArea.Width = dwX
.ChartArea.Height = dwY
.PlotArea.Left = 0.1 * dwX
.PlotArea.Top = 0.1 * dwY
.PlotArea.Width = 0.8 * dwX
.PlotArea.Height = 0.8 * dwY
End With
End With
Set objCh = Nothing

Ich hoffe, Du kannst das Dir hier herausholen, was Du für Deine aufgabe benötigst.
Gruß,
Uwe

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Makro Diagrammgrößen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread