Diagramm programmieren mit VBA Teil 1

und: der dynamische CommandButton Teil 1

Diagramme zu programmieren bietet den Vorteil der Dynamik, auf Wunsch auf Knopfdruck. Es ist aber ein sehr komplexes Thema in VBA. Einiges davon habe ich hier in Form zweier "Liniendiagramme" mit zusätzlichen "Sekundärachsen" dargestellt. Die meisten gebräuchlichen Formatierungen sind bereits eingearbeitet, so dass sie in eigenen Programmcode direkt übernommen werden können.
Äusserst hilfreich ist hier die With-Anweisung, die viel Schreibarbeit erspart.

Das zugehörige Workbook des hier vorgestellten Diagramms besteht aus 2 Worksheets: Auf dem ersten befindet sich die Datenbank und das zweite dient nur zur Anwahl des Datensatzes und zur Darstellung der Diagramme.
In der Datenbank werden auch die Masseinheiten ausgelesen, die dann in der Legende dynamisch angezeigt werden.

Gestartet wird die Prozedur über einen dynamischen CommandButton, der nur dann aktiviert ist, wenn sich die aktive Zelle im Auswahlbereich, der etwa 55 Positionen umfasst, befindet.
Dynamisch ist der Button auch deshalb, weil er mit der aktiven Zelle stetig mitwandert. Dieses Thema wird dann am Ende der Seite in Beispiel 2 behandelt.

Beide Programme sind im VBA-Editor im Codefenster des Diagramm- und Auswahlsheets einzugeben. In einem normalen Modul würden die Programme wegen des Bezugs auf den CommandButton so nicht funktionieren. Hier wären geringfügige Änderungen notwendig.

Anzeigebeispiel :Diagramme und die Auswahlliste (63KB)
Man achte auch auf den CommandButton, der sich links neben der ausgewählten Zelle befindet. Er wandert im wirklichen Leben :-) immer neben der aktiven Zelle mit.

Option Explicit

Private Sub CommandButton1_Click()

Dim Datenreihe(5), Monate, B As Range 'B ist Basispunkt im Datensheet
Dim Adresse As String 'Adressen der Datenreihen für Grafik 1
Dim Adresse2 As String 'Adressen der Datenreihen für Grafik 2
Dim Gname As String 'Name der aktiven Grafik
Dim A As String 'Name von Datenreihe 1
Dim C As String 'Name von Datenreihe 3
Dim X As Integer 'Zeile des gewälten Datensatzes
Dim Daten As Worksheet 'Datenbanksheet
Dim Analyse As Worksheet 'Grafiksheet

' aktive Zelle setzen (eigentlich nicht nötig: siehe Beschreibung)
If ActiveCell.Column <> 2 Then Cells(ActiveCell.Row, 2).Select
' Ende aktive Zelle setzen

' Eigenschaften und Werte zuweisen
A = ActiveCell.Value
X = ActiveCell.Row
Set Analyse = Sheets("Analyse Hiebe (Grafik)")
Set Daten = Sheets("Tabelle1")
C = "Ø Preis/" & Daten.Cells(X, 2).Offset(128, 14).Value
Set Monate = Sheets(1).Range(Cells(1, 3), Cells(1, 14))
Set Datenreihe(1) = Sheets(1).Range(Cells(X, 3), Cells(X, 14))
Set Datenreihe(2) = Sheets(1).Range(Cells(X + 64, 3), Cells(X + 64, 14))
Set Datenreihe(3) = Sheets(1).Range(Cells(X + 128, 3), Cells(X + 128, 14))
Set Datenreihe(4) = Sheets(1).Range(Cells(X + 198, 3), Cells(X + 198, 14))
Set Datenreihe(5) = Sheets(1).Range(Cells(196, 3), Cells(196, 14))
Set B = Cells(X, 2)
Adresse = Monate.Address & ", " & Datenreihe(1).Address & ", " & Datenreihe(2).Address & ", " & Datenreihe(3).Address
Adresse2 = Monate.Address & ", " & Datenreihe(5).Address & ", " & Datenreihe(4).Address
' Ende Eigenschaften und Werte zuweisen

Application.ScreenUpdating = False

' vorhandene Diagramme löschen:
Application.ActiveSheet.ChartObjects.Delete
' Ende vorhandene Diagramme löschen

' Diagramm hinzufügen und Typ festlegen:
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Analyse Hiebe (Grafik)"
ActiveChart.ChartType = xlLine
' Ende Diagramm hinzufügen und Typ festlegen

' Datenreihen zufügen, ausrichten und benennen:
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range( _
Adresse), PlotBy:=xlRows

ActiveChart.SeriesCollection(1).Name = A
ActiveChart.SeriesCollection(2).Name = "=""Kosten"""
ActiveChart.SeriesCollection(3).Name = C
' Ende Datenreihen zufügen, ausrichten und benennen

' Trendlinie hinzufügen:
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False).Select
ActiveChart.SeriesCollection(1).Trendlines(1).Name = "Trend Verbauch"
' Ende Trendlinie hinzufügen

' Gitternetzlinien zufügen:
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
' Ende Gitternetzlinien zufügen

' Legende und Datentabelle:
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.HasDataTable = False
' Ende Legende und Datentabelle

' Chartlinien formatieren:
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
End With

ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
.AxisGroup = 2
End With

ActiveChart.SeriesCollection(3).Select
With Selection.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.AxisGroup = 2
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
End With
' Ende Chartlinien formatieren

' Diagramm auf Bildschirm ausrichten:
ActiveChart.ChartArea.Select
Gname = Mid(ActiveChart.Name, 24, 100)
ActiveSheet.Shapes(Gname).ScaleWidth 1.29, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(Gname).IncrementLeft 67
ActiveSheet.Shapes(Gname).IncrementTop -105
' Ende Diagramm auf Bildschirm ausrichten

' Legende formatieren
ActiveSheet.ChartObjects(Gname).Activate
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = 1
.Pattern = xlSolid
End With
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
' Ende Legende formatieren

Windows("Analyse HiBe.xls").Activate
B.Select

'-----------------------------------------------------------------
'Diagramm 2: Ø Kosten / 1000qm

A = A & " - Preis/1.000m²"

' Diagramm hinzufügen und Typ festlegen:
Charts.Add
ActiveChart.ChartType = xlLine
ActiveChart.Location Where:=xlLocationAsObject, Name:="Analyse Hiebe (Grafik)"
' Ende Diagramm hinzufügen und Typ festlegen

' Datenreihen zufügen, ausrichten und benennen:
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range( _
Adresse2), PlotBy:=xlRows
ActiveChart.SeriesCollection(2).Name = A
ActiveChart.SeriesCollection(1).Name = "=""Prod. Mio. m²"""
' Ende Datenreihen zufügen, ausrichten und benennen

' Trendlinie hinzufügen:
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=False, DisplayRSquared:=False).Select
ActiveChart.SeriesCollection(2).Trendlines(1).Name = "Trend Preis/1.000m²"

' Ende Trendlinie hinzufügen

' Gitternetzlinien zufügen:
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
' Ende Gitternetzlinien zufügen

' Legende und Datentabelle:
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.HasDataTable = False
' Ende Legende und Datentabelle

' Chartlinien formatieren:
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
.AxisGroup = 2
End With

ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 6
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
.AxisGroup = 1
End With
' Ende Chartlinien formatieren

' Diagramm auf Bildschirm ausrichten:
ActiveChart.ChartArea.Select
Gname = Mid(ActiveChart.Name, 24, 100)
ActiveSheet.Shapes(Gname).ScaleWidth 1.29, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes(Gname).ScaleHeight 0.9, msoFalse, _
msoScaleFromTopLeft

ActiveSheet.Shapes(Gname).IncrementLeft 67
ActiveSheet.Shapes(Gname).IncrementTop 125
' Ende Diagramm auf Bildschirm ausrichten

' Legende formatieren
ActiveSheet.ChartObjects(Gname).Activate
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = 1
.Pattern = xlSolid
End With
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
' Ende Legende formatieren

Windows("Analyse HiBe.xls").Activate
B.Select
Application.ScreenUpdating = True

End Sub

Beispiel 2 nach oben

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim ACR, ACC As Integer
ACR = ActiveCell.Row
ACC = ActiveCell.Column

' gerade ist mir noch eingefallen, dass man
' hier auch mit "Intersect" arbeiten könnte...zu spät..
With ActiveSheet.CommandButton1
If ACC = 2 And ( _
ACR = 3 _
Or (ACR >= 6 And ACR <= 13) _
Or (ACR >= 16 And ACR <= 52) _
Or (ACR >= 54 And ACR <= 57) _
Or (ACR >= 59 And ACR <= 60)) _
Or ACR = 62 Then
.Top = ActiveCell.Offset(0, 0).Top
.Enabled = True
Else
.Top = ActiveCell.Offset(0, 0).Top
.Enabled = False
End If
End With

End Sub