VBA: Diagramm mit Datumsachse dynamisch erstellen
23.08.2016 14:48:13
Jessi
für eine Auswertung möchte ich ein Diagramm in Excel 2013 erstellen, welches automatisch über ein Makro ergänzt bzw. aktualisiert werden kann. Das heißt mein Diagramm soll dynamisch wachsen können, indem nach und nach immer mehr Arbeitsblätter hinzugefügt und ausgelesen werden.
Dazu habe ich bereits einige Auswertungsbögen in Excel importiert, sodass die notwendigen Informationen zwar in unterschiedlichen Blättern aber immer in der gleichen Zelle stehen (in meinem Fall C5).
Auf der x-Achse meines Diagramms soll das Datum stehen, welches der Name der einzelnen Arbeitsblätter ist und über eine Schleife ausgelesen und in einem anderen Arbeitsblatt Hilfswerte gespeichert wird (der Abstand zwischen den Daten soll genormt sein). Auf der y- Achse sollen Noten (von 1-4) stehen.
Die Datenreihe besteht dann aus den vergebenen Noten, welche auf den Auswertungsbögen bzw. in den Arbeitsblättern in Zelle C5 zu finden sind.
Gesammelt werden die Noten der Auswertungsbögen ebenfalls in dem Arbeitsblatt Hilfswerte (Durch eine Schleife die alle Arbeitsblätter abläuft, die Zelle C5 kopiert und im Arbeitsblatt Hilfswerte wieder abspeichert). Mit Hilfe dieser Werte möchte ich in einem anderen Arbeitsblatt Uebersicht das oben beschriebene Diagramm erstellen.
Allerdings funktioniert die Darstellung des Datums auf der x- Achse, sowie die Darstellung der Datenreihe nicht. Es wird der Laufzeitfehler 1004: ungültiger Parameter ausgeworfen.
Anbei mein Code, hat vielleicht jemand eine Idee woran das liegen könnte?
Danke schon jetzt für eure Hilfe
Modul 1:
Sub Diagramm_erstellen()
' vorhandene Diagramme löschen:
Dim anzahlDia As Long
With ActiveSheet
If .ChartObjects.count 0 Then
For anzahlDia = .ChartObjects.count To 1 Step -1
.ChartObjects(anzahlDia).Delete
Next anzahlDia
End If
End With
' Diagramm erstellen
Sheets("Uebersicht").Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLines
'Position und Größe festlegen
With ActiveChart.Parent
.Left = 90
.Top = 90
.Width = 500
.Height = 300
End With
'Diagramm Umrandung
With Selection.Format.Line
.Visible = msoTrue
.Weight = 4
End With
'Beschriftung Diagramm
With ActiveChart
.HasTitle = True
.ChartTitle.Text = "mittlere Bewertung"
'Beschriftung Achsen
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Datum"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Note"
End With
'Ruft Methode auf, um Werte aus Reiter auszulesen
Call WorksheetLoop
' Werte der x-Achse
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.Axes(xlCategory).TickLabels.Orientation = 45
.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "TT.MM.JJJJ"
.SeriesCollection(1).XValues = "='Hilfswerte'!$A$1:$A$4" 'Hier wird der Fehler geworfen
.Axes(xlCategory).MinorUnit = 1
End With
'Werte der y-Achse
With ActiveChart.Axes(xlValue)
.MaximumScale = 4
.MinimumScale = 0
.MinorUnit = 1
.MajorUnitIsAuto = True
End With
' Gitternetzlinien zufügen:
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
'Daten in Diagramm einfügen'
ActiveChart.FullSeriesCollection.name = "=""Durchschnittsnote"""
ActiveChart.FullSeriesCollection.Values = "='Hilfswerte'!$C$1:$C$4"
End Sub
Modul 2: (funktioniert fehlerfrei)
'Methode, um das Datum aus Reitername, sowie die Mittlere Bewertung auszulesen und in Arbeitsblatt "Hilfswerte" zwischen zu speichern
Sub WorksheetLoop()
Dim WS_Count As Integer
' I gibt die Nummer des Arbeitsblattes an
Dim I As Integer
' L gibt die Spaltennummer des Datenblatts "Hilfswerte" an.
Dim L As Integer
Dim name As String
Dim note As String
' WS_Count ist gleich der Nummer der Arbeitsblätter in der activen Arbeitsmappe.
WS_Count = ActiveWorkbook.Worksheets.count
L = 1
For I = 3 To WS_Count
name = ActiveWorkbook.Worksheets(I).name
Sheets("Hilfswerte").Range("A" & L).value = name
note = ActiveWorkbook.Worksheets(I).Range("C5")
ActiveWorkbook.Worksheets("Hilfswerte").Range("C" & L).value = note
L = L + 1
Next I
End Sub
Anzeige