fortlaufende Diagrammerstellung VBA
01.07.2013 23:31:10
Jens
ich habe bereits von Klaus M.vdT folgenden Makro für die automatische Erstellung eines Diagrammes mit einer Spalte erhalten, welches auch super funktioniert. Nun würde ich jedoch wissen wollen, was ich ändern müsste um jedem erstellten Diagramm noch Daten aus einer Spalte G und H zuzufügen. Als Ergebnis sollte jeweils ein Liniendiagramm mit 3 Linien dargestellt werden. Die Bezeichnung der Linien sollte entsprechend vom jeweiligen Begriff aus Zeile 1 gewählt werden.
Option Explicit
'ÄNDERUNG!
'die Diagrammbreite nicht mehr im Makro angeben, sondern
'das Diagramm nimmt die Breite der Spalte F an!
Public ScaleMax As Long
Public ScaleMin As Long
Sub MacheVieleDiagramme()
Const RowFirst As Long = 2 'Ab Zeile 2 stehen Daten
Const RowStep As Long = 72 'Diagramme in 72-Zeilen-Schritten erstellen
Const SpalteDaten = 6 'In Spalte F=6 stehen die Daten
Dim i As Long
'Bildschirmflackern verhindern
Application.ScreenUpdating = False
With ActiveSheet
'Diagramm scaliert von 0 bis Max-Wert
'Bei Bedarf ändern, auch fixe Werte möglich!
ScaleMax = WorksheetFunction.Max(.Cells(1, SpalteDaten).EntireColumn)
ScaleMin = 0
'gehe alle Zeilen in 72-er Steps durch
For i = RowFirst To Cells(.Rows.Count, SpalteDaten).End(xlUp).Row Step RowStep
'starte das Diagramm-Makro
MacheEinzelDiagramm .Cells(i, SpalteDaten).Resize(RowStep)
Next i
End With
End Sub
Sub MacheEinzelDiagramm(rngDaten As Range)
Dim myCht As Object
Set myCht = ActiveSheet.Shapes.AddChart 'neues Diagramm erstellen
With myCht 'mit dem gerade erstellten Diagramm
With .Chart
.ChartType = xlLine 'Liniendiagramm
.SetSourceData Source:=rngDaten 'Datenquelle übergeben
.Legend.Delete 'Legende entfernen
.Axes(xlValue).MaximumScale = ScaleMax 'auf 22000 (oder so) skalieren
.Axes(xlValue).MinimumScale = ScaleMin 'von 0 anfangend skalieren
End With
.Top = rngDaten.Top 'ausrichten
.Left = rngDaten.Offset(, 1).Left 'ausrichten
.Height = rngDaten.Height 'ausrichten
.Width = rngDaten.Offset(, 1).Width 'ausrichten
End With
End Sub
Jens