AW: Diagramm färben bei bedingter Formatierung
14.01.2014 12:16:39
Bastian
Hallo Marc,
probier mal folgenden Code:
Gruß, Bastian
Option Explicit
Sub DiaFaerben()
Dim lngPunkt As Long
Dim strBeruf As String
Dim lngColor As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(2)
For lngPunkt = 1 To .Points.Count
strBeruf = Sheets("Tabelle1").Cells(lngPunkt + 2, 6).Value
On Error Resume Next
lngColor = Sheets("Tabelle3").Cells(Application.Match(strBeruf, Sheets("Tabelle3") _
.Range("A2:A11"), 0) + 1, 1).Interior.Color
liesRGB lngColor, R, G, B
With .Points(lngPunkt).Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(R, G, B)
.Transparency = 0
.Solid
End With
Next
End With
End Sub
Function liesRGB(lngColor As Long, ByRef Red As Integer, _
ByRef Green As Integer, ByRef Blue As Integer)
On Error Resume Next
Red = lngColor Mod 256
lngColor = (lngColor - Red) / 256
Green = lngColor Mod 256
lngColor = (lngColor - Green) / 256
Blue = lngColor Mod 256
End Function