AW: Punkt (XY)Diagramm mit Makro erzeugen
18.08.2006 11:17:43
fcs
Hallo Frank,
ich arbeite nicht immer mit "Option Explicit", da kann es schon mal passieren, dass ich nur die Objekt-Variablen deklariere und die reinen Wert-Variablen vernachlässige.
Der Laufzeitfehler ist wie so oft auf das Zusammentreffen unglücklicher Umstände zurückzuführen. Das Makro stammt von einer Fassung, die die Datenreihen in Zeilen hatte, leider hatte ich vergessen den entsprechenden Zeilenzähler von Zeilen auf Spalten umzustellen. Im Beispiel mit 2 Datenreihen in Spalten passte es trotzdem. Bei mehr Spalten tritt der Laufzeitfehler auf.
Hier die angepasste Fassung.
Gruß
Franz
Option Explicit
Sub DatenbereichDiagramm()
Dim Daten As Range, wks As Worksheet, Zeile As Long, Spalte As Integer
Set wks = ActiveSheet
Zeile = 1 ' Nummer der Zeile mit den Kategorien (Aktie, Renten etc)
Spalte = 1 ' Nummer der Spalte mit den Beschriftungen X-Y-Achse (Ertrag, Risiko)
With wks
Set Daten = .Range(.Cells(Zeile, Spalte), .Cells(Zeile + 2, .Cells(Zeile, .Columns.Count).End(xlToLeft).Column))
End With
Call XY_diagramm_mit_Reihe_je_Spalte(Daten, wks)
End Sub
Private Sub XY_diagramm_mit_Reihe_je_Spalte(Daten As Range, wks As Worksheet)
' Erzeugt aus Bereich Daten ein XY-Punktdiagramm mit einer Reihe pro Spalte
' Bereich Daten muss beinhalten:
' 1. Spalte Kategorien (Beschriftung für X- und Y-Achse
' Spalte 2 bis X sind Datenreihen
' 1. Zeile Beschriftung Datenreihen
' 2. Zeile Y-Werte
' 3. Zeile X-Werte
Dim Reihe As Series, I As Integer
Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlXYScatter
ActiveChart.Location Where:=xlLocationAsNewSheet 'auf neuem Blatt
' ActiveChart.Location Where:=xlLocationAsObject, Name:=wks.Name 'auf dem Tabellenblatt
With wks
ActiveChart.SetSourceData Source:=.Range(.Cells(Daten.Row + 1, Daten.Column), _
.Cells(Daten.Row + Daten.Rows.Count - 1, Daten.Column + 3)), PlotBy:=xlRows
End With
Application.ScreenUpdating = False
For I = ActiveChart.SeriesCollection.Count To 2 Step -1
ActiveChart.SeriesCollection(I).Delete
Next
For I = 1 To Daten.Columns.Count - 1 '################### diese Zeile korrigieren
Set Reihe = ActiveChart.SeriesCollection(I)
With Reihe
.Name = "=" & wks.Name & "!R" & Daten.Row & "C" & Daten.Column + I
.XValues = "=" & wks.Name & "!R" & Daten.Row + 2 & "C" & Daten.Column + I
.Values = "=" & wks.Name & "!R" & Daten.Row + 1 & "C" & Daten.Column + I
.ApplyDataLabels ShowSeriesName:=True 'Rubrik wird am Datenpunkt angezeigt
End With
If I <> Daten.Columns.Count - 1 Then '################### diese Zeile korrigieren
ActiveChart.SeriesCollection.NewSeries
End If
Next
Application.ScreenUpdating = True
With ActiveChart
.HasLegend = False
.HasTitle = True
.ChartTitle.Characters.Text = InputBox("Diagrammtitel", "Neues Diagramm", "Rendite Anlageklassen")
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung X-Achse:", "Neues Diagramm", Daten(3, 1))
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung Y-Achse:", "Neues Diagramm", Daten(2, 1))
End With
End Sub