ich versuche gerade ein Makro zu schreiben, welche die selbe Formattierung auf alle Diagramme anwendet. Code unten zu sehen; dazu noch eine kleine Erläuterung:
Zuerst werden 2 Diagramme erstellt, welche jeweils auf verschiedene Daten zugreifen.
Danach folgt mein Versuch, die Formattierung auf alle Diagramme (ChartObjects) anzuwenden, um die Formattierung nicht für beide Diagramme einzeln zu schreiben (auch wenn es nur Copy&Paste ist).
Als drittes will ich dann noch ein Makro schreiben, welches die Balken der Diagramme nach dem Wert färbt; z.B. 97 = grün.
Hier der Code:
Sub CreateChart()
Dim CO1 As ChartObject, CH1 As Chart, CO2 As ChartObject, CH2 As Chart, AllC As ChartObjects
'########### Chart 1 (ChartAbove)
Set CO1 = ThisWorkbook.Worksheets("Template").ChartObjects.Add(100, 100, 295, 220)
CO1.Name = "ChartAbove"
' Diagramm [erstellt das Diagramm innerhalb des Diagrammrahmens]
Set CH1 = CO1.Chart
CH1.ChartType = xlColumnStacked
CH1.SetSourceData Worksheets("2014 IT KPIs").Range("C2:O4")
'Title
CH1.HasTitle = True
With CH1.ChartTitle
.Font.Size = 11
.Text = Worksheets("2014 IT KPIs").Cells(3, 2)
End With
'########### Chart 2 (ChartBelow)
Set CO2 = ThisWorkbook.Worksheets("Template").ChartObjects.Add(300, 300, 295, 220)
CO2.Name = "ChartBelow"
' Diagramm [erstellt das Diagramm innerhalb des Diagrammrahmens]
Set CH2 = CO2.Chart
CH2.ChartType = xlColumnStacked
CH2.SetSourceData Worksheets("2014 IT KPIs").Range("C2:O4")
'Title
CH2.HasTitle = True
With CH2.ChartTitle
.Font.Size = 11
.Text = Worksheets("2014 IT KPIs").Cells(3, 2)
End With
'########## Chart Properties
Set AllC = Worksheets("Template").ChartObjects
For Each AllC In Worksheets("Template").ChartObjects
With AllC.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 1
' // Axis title
'.HasTitle = True
'.AxisTitle.Text = "Percent"
End With
Next
For Each AllC In Worksheets("Template").ChartObjects
' Datenreihe Target
With CH1.SeriesCollection(2)
.Type = xlLine
.Border.Color = vbRed
.MarkerStyle = xlMarkerStyleCircle
With CH1.SeriesCollection(2).Points(12)
.HasDataLabel = True
.DataLabel.Position = xlLabelPositionAbove
'.DataLabel.Orientation = 45
End With
End With
Next
End Sub
Ich bekomme den Fehler Type mismatch. ich bin mir ziemlich sicher, dass ich bisher auf dem Holzweg bin, was die Vorgehensweise angeht. Das Internet habe ich schon zuhauf durchforstet, bin aber nie komplett zum Ziel gekommen.
Könnt ihr mir einen Rat geben?
Danke!
Frederik