ich suche einen Weg wie ich bei einem Balkendiagramm die Farbe der Zelle aus der die Daten kommen entnehmen kann und damit den entsprechenden Balken des Diagrammes einfärben kann. Ist dies jemand bekannt?
Vielen Dank Chris
Sub BalkenFaerben()
'Diagramm Balken färben
Dim xPoints As Integer, xRows As Integer
Dim oZiel As Range
Set oZiel = ActiveSheet.Range("A2") 'Beginnzelle der Reihe
xRows = 1 'Erste Balkenreihe
'Alle Datenpunkte der aktuellen Datenreihe durchgehen
'Chart muss aktiviert sein
With ActiveChart
For xPoints = 1 To .SeriesCollection(xRows).Points.Count
With .SeriesCollection(xRows).Points(xPoints)
.Interior.Color = oZiel.Offset(0, xPoints - 1).Interior.Color
End With
Next xPoints
End With
End Sub
Sub BalkenFaerbenAusZellfarben()
'Diagramm Balken färben
Dim xPoints As Integer, xRows As Integer, sArr() As String
'Alle Datenpunkte der aktuellen Datenreihe durchgehen
With ActiveSheet.ChartObjects("Diagramm 3").Chart 'Chartnamen anpassen
For xRows = 1 To .SeriesCollection.Count
With .SeriesCollection(xRows)
sArr = Split(.Formula, "$")
For xPoints = 1 To .Points.Count
With .Points(xPoints)
.Interior.Color = Range(sArr(5) & Replace(sArr(6), ":", "")) _
.Offset(0, xPoints - 1).Interior.Color
End With
Next xPoints
End With
Next xRows
End With
End Sub
Sub BalkenFaerbenAusZellfarben()
'Diagramm Balken färben, Datenanordnung senkrecht
Dim xPoints As Integer, rField As Range, sArr() As String
'Alle Datenpunkte der aktuellen Datenreihe durchgehen
With Sheets("Tabelle1").ChartObjects("Diagramm 1").Chart 'Chartnamen ggf. anpassen
With .SeriesCollection(2)
sArr = Split(.Formula, "$") 'Anfangsfeld holen
Set rField = Range(sArr(3) & Replace(sArr(4), ":", "")) 'und setzen
For xPoints = 1 To .Points.Count 'Alle Punkte durchgehen
With .Points(xPoints)
.Interior.Color = rField.Offset(xPoints - 1, 0).Interior.Color
End With
Next xPoints
End With
End With
End Sub