AW: Diagrammersterllung mit variabler Adressierung
15.11.2023 17:49:34
Beverly
Hi reiner,
ich habe im Modul "DiagrammErstellen" eine Public-Variable deklariert - Public arrReihen(). Im Code deines CommandButtons "cmdDiagramm" werden auf diese Variable die Spaltennummern geschrieben, in denen sich die anzuzeigenden Daten befinden, wenn die betreffende CheckBox ausgewählt ist:
Private Sub cmdDiagramm_Click()
'**************************************************
Dim ctrElement As Control
Dim intZaehler As Integer
' Schleife über alle Steuerelemente des UF
For Each ctrElement In Me.Controls
' die linken 3 Buchstaben des Namen sind "chk"
If Left(ctrElement.Name, 3) = "chk" Then
' CheckBox ist aktiviert!!
If ctrElement Then
' Array redimensionieren
ReDim Preserve arrReihen(0 To intZaehler)
arrReihen(intZaehler) = Right(ctrElement.Name, 1) * 1 + 2 '== Spaltennummer abgeleitet aus dem Zusatz zu "chk" ins Array schreiben
intZaehler = intZaehler + 1
End If
End If
Next ctrElement
'**************************************************
DiagrammGenrieren
frmBeenden.chk1.Value = False
frmBeenden.chk2.Value = False
frmBeenden.chk3.Value = False
frmBeenden.chk4.Value = False
frmBeenden.chk5.Value = False
End Sub
Daraus ergibt sich dann folgender Code für das Erstellen des Diagramms:
Function DiagrammGenrieren()
Dim intReihe As Integer
Application.ScreenUpdating = False
Set WksTab = Worksheets("Stromverbrauch 2023")
ZeileMonatsErster = 105
ZeileMonatsLetzter = 135
With WksTab
.Unprotect
' Diagramm(e) vorhanden dann alle löschen
If .ChartObjects.Count > 0 Then .ChartObjects.Delete
frmBeenden.cmdDiagramm.Enabled = False
' Diagramm hinzufügen mit den Dimensionen 0
Set Dia = .ChartObjects.Add(0, 0, 0, 0)
With Dia
' Schleife über alle Einträge im Array
For intReihe = 0 To UBound(arrReihen())
' neue Datenreihe erstellen
With .Chart.SeriesCollection.NewSeries
' Name aus Zeile 2, Spaltennummer aus Array
.Name = WksTab.Cells(2, arrReihen(intReihe))
' Wertebereich zuweisen, Spaltennummer aus Array
.Values = WksTab.Range(WksTab.Cells(ZeileMonatsErster, arrReihen(intReihe)), WksTab.Cells(ZeileMonatsLetzter, arrReihen(intReihe)))
End With
Next intReihe
' der 1. Datenreihe den Achsenbeschriftungsbereich zuweisen
' ist bei einem Liniendiagramm nur bei 1 Datenreihe erforderlich
.Chart.SeriesCollection(1).XValues = WksTab.Range(WksTab.Cells(ZeileMonatsErster, 1), WksTab.Cells(ZeileMonatsLetzter, 1))
.Name = "Diagramm 1"
' Diagrammtyp 3DLinie zuweisen
.Chart.ChartType = xl3DLine
' Größenwerte dem Diagramm zuweisen
.Left = 100
.Width = 1000
.Top = 1700
.Height = 600
' Beschriftungsformat Horizontalachse anpassen
.Chart.Axes(xlCategory).TickLabels.NumberFormat = "ddd. dd.mm.yyyy"
End With
.Protect
End With
End Function
Bis später
Karin
Link zur Homepage: https://excel-inn.de/