Farben im Diagramm fixieren

Forumthread: Farben im Diagramm fixieren
4 Beiträge zu diesem Forumthread
Anzeige
VBA Beispiele zu verwandten Themen

Forumthread: Farben im Diagramm fixieren

13.10.2016 17:19:50

Tim

Hallo zusammen,
wie kann die die Farben in einem Diagramm fixieren?
Ich versuche mein Problem zu erläutern:
Ich habe ein Diagramm erstellt, bei der ich folgende Farben eingestellt habe (einfaches Beispiel):
"Äpfel" = rot
"Trauben" = grün
"Karotten" = orange
Erst im Anschluss mache ich eine Sortierung nach Menge:
15 Karotten
10 Äpfel
5 Trauben
Die Farben ändern sich aber nicht mit, so dass es jetzt wie folgt aussieht:
Karotten sind rot statt orange
Äpfel sind grün
Trauben orange
Ich hoffe, ich konnte mich verständlich ausdrücken und jemand von euch hat eine Idee.
Danke & Gruß
Tim

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Bitte Beispielmappe hochladen - o.w.T

14.10.2016 14:04:49

Beverly
AW: Bitte Beispielmappe hochladen - o.w.T

14.10.2016 15:25:55

Tim
AW: Bitte Beispielmappe hochladen - o.w.T

14.10.2016 18:09:46

Beverly
AW: Bitte Beispielmappe hochladen - o.w.T

17.10.2016 09:43:51

Tim

Bitte Beispielmappe hochladen - o.w.T

14.10.2016 14:04:49

Beverly

AW: Bitte Beispielmappe hochladen - o.w.T

14.10.2016 15:25:55

Tim

Hier ein Beispiel:
https://www.herber.de/bbs/user/108792.xlsx
Danke & Gruß
Tim

AW: Bitte Beispielmappe hochladen - o.w.T

14.10.2016 18:09:46

Beverly

Hi Tim,
das geht mit VBA. Formatiere dazu die Zellen mit den Y-Werten für das Diagramm mit der entsprechenden Farbe und führe dann dieses Makro aus:

Sub Faerben()
Dim serReihe As Series
Dim rngSuche As Range
Dim rngBereich As Range
Dim lngPunkt As Long
Set serReihe = ActiveSheet.ChartObjects("Diagramm 2").Chart.SeriesCollection(1)
With serReihe
Set rngBereich = Range(Split(.Formula, ",")(1))
For lngPunkt = 1 To .Points.Count
Set rngSuche = rngBereich.Find(.XValues(lngPunkt), lookat:=xlWhole)
.Points(lngPunkt).Interior.Color = rngSuche.Offset(0, 1).Interior.Color
Next lngPunkt
End With
End Sub