Excel – Diagrammfarben per VBA zuweisen
Den Datenreihen meines Diagramms möchte ich feste Farbwerte zuweisen. Die gleiche Stadt soll im Diagramm immer die gleiche Farbe zugewiesen bekommen.
Wie das Makro funktioniert, sehen Sie hier:
Videolink: http://youtu.be/_1ue9imc4yc
VBA-Code:
Sub Farben_Diagramm()
Dim chtDiagramm As Chart
Dim i As Integer, j As Integer, intColor As Integer, intSeries As Integer
Dim strName As String, strChart As String, strBlatt As String
On Error GoTo ErrorHandler
strBlatt = „Versuch“
strChart = „chartPersonal“
Set chtDiagramm = Sheets(strBlatt).ChartObjects(strChart).Chart
intSeries = chtDiagramm.SeriesCollection.Count
chtDiagramm.SetElement (msoElementDataLabelNone)
chtDiagramm.SetElement (msoElementDataLabelCenter)
For i = 1 To intSeries
strName = chtDiagramm.SeriesCollection(i).Name
For j = 2 To Range(„rng_Orte“).Value + 1
If Sheets(„Versuch“).Cells(j, 9).Value = strName Then
intColor = Sheets(„Versuch“).Cells(j, 14).Value
With chtDiagramm.SeriesCollection(strName)
.Format.Fill.Visible = msoTrue
.Format.Fill.ForeColor.RGB = RGB(Sheets(„Versuch“).Cells(j, 11).Value, _
Sheets(„Versuch“).Cells(j, 12).Value, Sheets(„Versuch“).Cells(j, 13).Value)
With .DataLabels.Format.TextFrame2.TextRange.Font.Fill
.ForeColor.RGB = RGB(intColor, intColor, intColor)
.Solid
End With
.DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
End With
End If
Next j
Next i
Exit Sub
ErrorHandler:
MsgBox „Ein Fehler ist aufgetreten“, vbInformation, „Fehler “ & Err.Number
End Sub
Wie kommt man auf so einen Code? Ich habe mir die Makroaufzeichnung zu Nutze gemacht:
Videolink: http://youtu.be/iHae8Su6GGo
Hier wird der Code von oben erläutert:
Videolink: http://youtu.be/Yrl7-PZiMjg