860to864: Datenpunktfarbe, abhaengig.....

Forumthread: Datenpunktfarbe, abhaengig.....

Datenpunktfarbe, abhaengig.....

05.04.2007 14:38:00

th.heinrich

bestes Forum,
mit folgendem code wird zellen in abhaengigkeit des inhaltes eine farbe zugewiesen.


Sub farbe()
Dim rng As Range
Dim bereich As Range
Set bereich = [I2:I100]
[I2:I100].Interior.ColorIndex = xlNone
For Each rng In bereich
If rng  "" Then
'If Intersect(Target, Range("k2:k55")) Is Nothing Then Exit Sub
Select Case rng
Case "30 Q83 BW3:FixM", "60 Q83 BW3:FixM"
rng.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015", "60 Q83 BW3:1015"
rng.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815", "60 Q83 BW3:1815"
rng.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM", "60 Q83 BW4:FixM"
rng.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015", "60 Q83 BW4:1015"
rng.Interior.ColorIndex = 8
Case "30 Q83 BW4:1815", "60 Q83 BW4:1815"
rng.Interior.ColorIndex = 34
Case "30 Q2000 BW3:FixM", "60 Q2000 BW3:FixM"
rng.Interior.ColorIndex = 39
Case "30 Q2000 BW3:1015", "60 Q2000 BW3:1015"
rng.Interior.ColorIndex = 37
Case "30 Q2000 BW3:1815", "60 Q2000 BW3:1815"
rng.Interior.ColorIndex = 41
Case "30 Q2000 BW4:FixM", "60 Q2000 BW4:FixM"
rng.Interior.ColorIndex = 36
Case "30 Q2000 BW4:1015", "60 Q2000 BW4:1015"
rng.Interior.ColorIndex = 6
Case "30 Q2000 BW4:1815", "60 Q2000 BW4:1815"
rng.Interior.ColorIndex = 44
End Select
End If
Next
End Sub

wie ist es nun machbar den Datenpunkten eines diagramms anhand obiger beschriftungen dieselben farben zuzuweisen. es handelt sich um eine Datenreihe.
vielen dank fuer Eure hilfe
thomas

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datenpunktfarbe, abhaengig.....

05.04.2007 17:44:00

Herbert
AW: Datenpunktfarbe, abhaengig.....

05.04.2007 17:44:00

Herbert
Datenpunktfarbe, abhaengig, vielen dank

06.04.2007 17:25:00

th.heinrich

AW: Datenpunktfarbe, abhaengig.....

05.04.2007 17:44:00

Herbert

hallo Thomas,
in etwa so:


Public Sub dp_färben_1()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
For Each pkt In .SeriesCollection(1).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
End Select
Next
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
End With
End Sub

gruß Herbert

AW: Datenpunktfarbe, abhaengig.....

05.04.2007 17:44:00

Herbert

hallo Thomas,
in etwa so:


Public Sub dp_färben_1()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
For Each pkt In .SeriesCollection(1).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
End Select
Next
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
End With
End Sub

gruß Herbert

Datenpunktfarbe, abhaengig, vielen dank

06.04.2007 17:25:00

th.heinrich

hallo Herbert,
besten dank, wieder einmal eine Deiner tollen loesungen. fuer mein heim xl97 musste ich nochwas aendern.


Public Sub dp_färben_2()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
'.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
'damit konnte mein heim xl97 nichst anfangen.
.SeriesCollection(2).ApplyDataLabels Type:=xlDataLabelsShowLabel
For Each pkt In .SeriesCollection(2).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM", "60 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015", "60 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815", "60 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM", "60 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015", "60 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
Case "30 Q83 BW4:1815", "60 Q83 BW4:1815"
pkt.Interior.ColorIndex = 34
Case "30 Q2000 BW3:FixM", "60 Q2000 BW3:FixM"
pkt.Interior.ColorIndex = 39
Case "30 Q2000 BW3:1015", "60 Q2000 BW3:1015"
pkt.Interior.ColorIndex = 37
Case "30 Q2000 BW3:1815", "60 Q2000 BW3:1815"
pkt.Interior.ColorIndex = 41
Case "30 Q2000 BW4:FixM", "60 Q2000 BW4:FixM"
pkt.Interior.ColorIndex = 36
Case "30 Q2000 BW4:1015", "60 Q2000 BW4:1015"
pkt.Interior.ColorIndex = 6
Case "30 Q2000 BW4:1815", "60 Q2000 BW4:1815"
pkt.Interior.ColorIndex = 44
End Select
Next
'.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
.SeriesCollection(2).ApplyDataLabels Type:=xlNone
End With
End Sub

frohe ostertage von
thomas

Beliebteste Forumthreads (12 Monate)

860to864: Datenpunktfarbe, abhaengig.....

Forumthread: Datenpunktfarbe, abhaengig.....

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread