AW: makro verallgemeinern
12.04.2007 06:43:32
Ceci
Hallo Christian,
ich habe hier mal meinen Code für die Diagrammerstellung für dich:
Sub Diagramm_Gesamt_erstellen()
Dim WSDia As Worksheet
Dim chtChart As Chart
Dim ChtChartArea As ChartArea
Dim ChtAxis As Axis
Dim Jahr As String
Dim ch As ChartObject
Set WSDia = Worksheets("Diagramm_Gesamt") 'Hier: set wsdia=ActivesSheet
'im Vorfeld ein evtl. vorhandenes Diagramm löschen!
On Error Resume Next
Application.DisplayAlerts = False
For Each ch In Sheets("Diagramm_Gesamt").ChartObjects
ch.Delete
Next ch
Application.DisplayAlerts = True
'Diagramm einfügen
WSDia.ChartObjects.Add Left:=0, Top:=265, Width:=355, Height:=170
WSDia.ChartObjects(1).Name = "Dia_Gesamt"
'Datentyp und Range bestimmen
Set chtChart = WSDia.ChartObjects(1).Chart
chtChart.ChartType = xlXYScatter
chtChart.SetSourceData Source:=WSDia.Range("B13:E13")
'Legende "Reihe 1" löschen
ActiveSheet.ChartObjects("Dia_Gesamt").Activate
ActiveChart.Legend.Select
Selection.Delete
'Farben im Diagramm
Set ChtChartArea = chtChart.ChartArea
With ChtChartArea
.Border.ColorIndex = RGB(192, 192, 192)
.Interior.Color = RGB(255, 255, 128)
.Font.Name = "Arial"
End With
Set ChtChartArea = Nothing
'Achsenformatierung
'ActiveSheet.ChartObjects.Activate
ActiveSheet.ChartObjects("Dia_Gesamt").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 1
.MaximumScale = 4
.MinorUnit = 0.1
.Crosses = xlCustom
.CrossesAt = 0
.ReversePlotOrder = True
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'Achsenbeschriftung
Set ChtAxis = chtChart.Axes(xlCategory) 'y-Achse
On Error Resume Next
With ChtAxis
.HasTitle = True
.CategoryNames = WSDia.Range("B12:E12")
.HasMajorGridlines = False
.HasMinorGridlines = True
.AxisTitle.Text = "Quartale/ quarters"
.AxisTitle.Font.Bold = True
.AxisTitle.Font.Underline = True
.AxisTitle.Font.Size = "12"
End With
Set ChtAxis = chtChart.Axes(xlValue) 'x-Achse
With ChtAxis
.HasTitle = True
.AxisTitle.Text = "Benotung/ grading"
End With
End Sub