AN ALLE!
16.06.2008 12:23:52
Engin
Ich brauch unbedingt Hilfe, wer kann mir helfen.
https://www.herber.de/bbs/user/53133.xls
Ich habe hier ein Code es funktioniert auch aber ich möchte ihn ergänzen ,
so das er auch für eine zweite Datenreihe funktioniert.
Am besten schaut euch das mal an.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim chDiagramm As Chart ' Variable für das Diagramm als Objekt
Dim raZelle As Range
' wenn Änderung nicht im definierten Bereich
If Intersect(Target, Range("C8:C13")) Is Nothing Then Exit Sub
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' Diagramm1 der Variablen zuweisen
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm
If Target.Count > 1 Then
For Each raZelle In Selection
With .SeriesCollection(1).Points(raZelle.Row - 7)
If raZelle > 0 Then
' Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
' Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf raZelle "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
Next raZelle
Else
' Datenpunktposition innerhalb der Reihe wird aus der Zeile ermittelt
With .SeriesCollection(1).Points(Target.Row - 7)
If Target > 0 Then
' Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
' Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf Target "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
End If
End With
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub