AW: Diagrammsäulen wechseln mit Höhe die Farben
23.11.2006 16:27:57
fcs
Hallo Roland,
ja das geht irgendwie und zwar per VBA-Makros
Je nachdem, ob das Diagramm auf einem eigenen Blatt erstellt oder als Objekt im Tabellenblatt muss/kann man das zugehörige Ereignismakro etwas unterschiedlicher gestalten.
Gruß
Franz
Diagramm in eigenem Registerblatt.
Das Diagramm wird beim Aktivieren des Blattes aktualisiert. Der Code muss im VBA-Editor unter dem Diagramm eingefügt werden.
Private Sub Chart_Activate()
Dim Reihe As Series
'in nächster Zeile ggf. Nr. der Datenreihe anpassen
Set Reihe = ActiveChart.SeriesCollection(1) '1. Datenreihe des Diagramms
For i = 1 To Reihe.Points.Count
Select Case Application.WorksheetFunction.Index(Reihe.Values, i)
Case Is > 3
Reihe.Points(i).Interior.ColorIndex = 3 'rot
Case Is >= 2
Reihe.Points(i).Interior.ColorIndex = 6 'gelb
Case Else
Reihe.Points(i).Interior.ColorIndex = 4 'grün
End Select
Next
End Sub
Diagramm als Objekt im Tabellenblatt.
Das Diagramm wird nach Ändern eines Wertes in der Datenreihe aktualisiert. Der Code muss im VBA-Editor unter der Tabelle eingefügt werden.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, Reihe As Series, strBereich As String
'in nächster Zeile ggf. Namen des Diagramms und Nr. der Datenreihe anpassen
Set Reihe = Me.ChartObjects("Diagramm 1").Chart.SeriesCollection(1) '1. Datenreihe des Diagramms
'Bereich mit den Werten der Datenreihe
strBereich = Mid(Reihe.FormulaLocal, InStrRev(Reihe.FormulaLocal, "!") + 1 _
, InStrRev(Reihe.FormulaLocal, ";") - InStrRev(Reihe.FormulaLocal, "!") - 1)
Set Bereich = Range(strBereich)
If Intersect(Target, Bereich) Then
For i = 1 To Reihe.Points.Count
Select Case Application.WorksheetFunction.Index(Reihe.Values, i)
Case Is > 3
Reihe.Points(i).Interior.ColorIndex = 3 'rot
Case Is >= 2
Reihe.Points(i).Interior.ColorIndex = 6 'gelb
Case Else
Reihe.Points(i).Interior.ColorIndex = 4 'grün
End Select
Next
End If
End Sub