Office: XY-Diagrammlinien mit Farbe der Zelle des Reihennamens färben

Hi Beverly und andere Excel-Profis!

Ich arbeite gerade an einer Liste mit diversen XY-Diagrammen in verschiedenen Blättern.
Das Blatt Diagramm enthält 3 Charts
Dann folgen Blatt A, B, C und D mit jeweils einem Chart und gefärbten Zellen
Und zu schluss das Blatt Daten mit den Daten.

Ich würde jetzt gerne mit der Farbe der Zelle des Reihennamens aus dem Blatt Daten (z.B. A) die Datenreihen bzw Linien der 3 Charts, welche sich in dem Blatt Diagramm befinden färben. Weiters sollen die gefärbten Zellen im Blatt A mit derselben Farbe gefärbt werden. (Die Charts in den Blättern A, B, C, D sollen andere Farben erhalten).

Vielen Dank im vorraus,

lg, Badaway

 

Hi Badaway,

das Anpassen der Reihenfarben im Tabellenblatt "Diagramme" kannst du so lösen:

Code:

Sub DatenreihenFaerben()
   Dim lngReihe As Long
   Dim strReihe As String
   Dim lngZellFarbe As Long
   Dim chrDia As ChartObject
   For Each chrDia In Worksheets("Diagramm").ChartObjects
      With chrDia.Chart
         For lngReihe = 1 To .SeriesCollection.Count
            strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
            strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
            With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(lngReihe).Format.Line
               .Visible = msoTrue
               .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
               .Transparency = 0
            End With
         Next lngReihe
      End With
   Next chrDia
End Sub

Was deine andere Frage bezüglich der Färbung der Zellen angeht - worus ist ersichtliche, welcher Zellbereich gefärbt werden soll? Klar, in deinen Tabellenblättern sind die Breich schon gefärbt, von Hand nehme ich an, aber wie kann VBA erkennen, um welche Bereiche es sich handelt, denn sie sind ja in jedem Tabellenblatt anders.


Bis später,
Karin

 

Hi Karin,

vielen Dank für die schnelle Lösung!

Der Code funkt vom Prinzip genau wie ich es mir vorgestellt habe. Mir fehlt nur leider der Durchblick um den Code richtig anzupassen.

1. In den Charts befinden sich noch die Datenreihen "VB50" und "Intersections". Diese waren vorher Schwarz bzw. Rot und sollen die Farbe nicht ändern. Jetzt sind sie weiß. Wie kann ich diese am einfachsten wieder mit den alten Farben einfärben? Soll ich Datenreihen neben A, B, C und D aufbereiten und die Zellen der Namen eifärben oder ist es möglich diese auszuschließen?

2. Es ändern sich nur die Farben der Datenreihen von einem Chart und nicht von allen. Wie kann ich das lösen?

Das mit den anderen Tabellenblättern muss ich scheinbar nochmal überdenken, aber eines nach dem anderen ;)#

Danke nochmal,

Rene

 

Hi Rene,


zu 1.: ergänze den Code wie folgt:

Code:

         For lngReihe = 1 To .SeriesCollection.Count
            [COLOR=#ff0000]If InStr(.SeriesCollection(lngReihe).Name, "VB") = 0 Then[/COLOR]
               strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
               strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
               With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(lngReihe).Format.Line
                  .Visible = msoTrue
                  .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
                  .Transparency = 0
               End With
            [COLOR=#ff0000]End If[/COLOR]
         Next lngReihe

Zu 2.: mit dem Code werden die Datenreihen aller 3 Diagramme im Tabellenblatt "Diagramm" geändert - nicht nur von einem der 3 Diagramme. Das erkennst du daran, dass der Code in einer Schleife abläuft

Code:

For Each chrDia In Worksheets("Diagramm").ChartObjects

Bis später,
Karin

 

Hi Rene,

ich habe gerade gesehen, dass in dieser Codezeile der rot markierte Teil noch weg muss:

Code:

               With [B][COLOR=#ff0000]ActiveSheet.ChartObjects(1).Chart[/COLOR][/B].SeriesCollection(lngReihe).Format.Line

Ich hatte ihn zu Testzwecken eingefügt und dann vergessen, ihn wieder zu entfernen, als ich den Code gepostet habe. Der Code bedeutet, dass nur im 1. Diagramm die Datenreihen geändert werden sollen, was natürlich falsch ist. Nun sollten auch tatsächlich die Datenreihen in allen 3 Diagrammen korrekt formatiert werden.

Bis später,
Karin

 

Hey Karin,

du bist ein Wahnsinn!!! :) Danke!

Kannst du mir noch erklären wie ich andere Optionen wie z.B. ändern der Größe oder Stärke der Markierungspunkte einbauen kann?

Ich habe den Code auch verwendet um die Diagramme der anderen Blätter von A bis D einzufärben. Funktioniert so wie unten eingefügt, doch vl hast du eine elegantere Lösung? Der Vorteil hier wäre, dass ich für jedes Diagramm eigene Einstellungen festlegen kann. Ist aber eig nicht notwendig.

Code:

Sub DatenreihenFaerbenAbisD()
   Dim lngReihe As Long
   Dim strReihe As String
   Dim lngZellFarbe As Long
   Dim chrDia As ChartObject
   For Each chrDia In Worksheets("A").ChartObjects
      With chrDia.Chart
         For lngReihe = 1 To .SeriesCollection.Count
            strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
            strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
            With .SeriesCollection(lngReihe).Format.Line
               .Visible = msoTrue
               .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
               .Transparency = 0
            End With
         Next lngReihe
      End With
   Next chrDia
   
   For Each chrDia In Worksheets("B").ChartObjects
      With chrDia.Chart
         For lngReihe = 1 To .SeriesCollection.Count
            strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
            strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
            With .SeriesCollection(lngReihe).Format.Line
               .Visible = msoTrue
               .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
               .Transparency = 0
            End With
         Next lngReihe
      End With
   Next chrDia
.......

Zu den eingefärbten Zellen: Ist es möglich, dass VBA eingefärbte Zellen in einem Tabellenblatt (z.B. A) und nur diese mit derselben Farbe der Datenreihen einfärbt? Andere Zellen werden nämlich nicht gefärbt und anfangs muss ich es immer manuell einfärben um das Layout zu bestimmen doch für die farbliche Abstimmung wärs dann praktisch.

Bis später, Rene

 

Hi Rene,

zu Frage 1: die Marker verändern kann man gewiss, aber da müsste man schon wissen wie sie aussehen sollen.

.MarkerStyle ist die Form
.MarkerSize ist die Größe
.Format.Fill ist die Füllung, die sich wiederum in mehrere Eigenschaften unterteilt
.Format.Line ist die Markerumrandung, die sich ebenfalls in mehrere Eigenschaften untereilt

Wie der relevante Code dafür auszusehen hat, kann man mit dem Makrorekorder aufzeichnen



Zu Frage 2: ich nehme an, du meinst das so

Code:

Sub DatenreihenFaerben()
   Dim lngReihe As Long
   Dim strReihe As String
   Dim lngZellFarbe As Long
   Dim chrDia As ChartObject
   Dim wksTab As Worksheet
   Dim rngZelle As Range
   For Each wksTab In Worksheets
      ' Schleife über alle Diagramm
      For Each chrDia In wksTab.ChartObjects
         With chrDia.Chart
            For lngReihe = 1 To .SeriesCollection.Count
               If InStr(.SeriesCollection(lngReihe).Name, "VB") = 0 Then
                   strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
                   strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
                   With .SeriesCollection(lngReihe).Format.Line
                      .Visible = msoTrue
                      .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
                      .Transparency = 0
                   End With
               End If
            Next lngReihe
         End With
      Next chrDia
      ' falls nur 1 Diagramm vorhanden
      If wksTab.ChartObjects.Count = 1 Then
         ' aisfürhen im betreffenden tabellenblatt
         With wksTab
            ' schleife über alle Zellen im benutzten Bereich
            For Each rngZelle In .UsedRange
               ' laufende Zelle hat Hintergundfarbe, dann färben wie Zelle für den Reihennamen
               If rngZelle.Interior.ColorIndex <> xlNone Then .Range(rngZelle.Address).Interior.Color = _
                  Worksheets("Daten").Range(strReihe).Interior.Color
            Next rngZelle
         End With
      End If
   Next wksTab
End Sub

Bis später,
Karin

 

Hi Karin,

guter Tipp mit dem Makrorecorder, ich werd mich da mal spielen. :)

Zu dem neuen Code:
Cool, funktioniert! Mir ist nur aufgefallen, dass die gefärbten Zellen in den Blättern immer die Farbe der letzten Datenreihe annehmen. Besser wäre, wenn die Farbe der Zellen in den Blättern von A bis D die Farbe des Reihennamens der Diagramme aus dem Blatt Diagramm hat.

Die Liste ist so zu verstehen:
Es werden 4 Produkte getestet - A, B, C, D
Die Diagramme im Blatt Diagramm zeigen wie sich die 4 Produkte zueinander verhalten. Jedes Produkt erhält eine Farbe. In den Blättern A bis D gehe ich dann detailliert auf die Produkte ein und zeige in den einzelnen Diagrammen die Entwicklung des einzelnen Produktes. Die Datenreihen der Einzeldiagramme erhalten unterschiedliche Farben - siehe Anhang. Anbei ein Beispiel

Lg, Rene

 

Hi Rene,

aus deiner vorhergehenden Mappe hatte ich etwas anderes entnommen und meinen Code dahingehend geschrieben - Antworten können immer nur so genau sein, wie die Vorgaben sind...:)

Code:

Sub DatenreihenFaerben()
   Dim lngReihe As Long
   Dim strReihe As String
   Dim chrDia As ChartObject
   Dim wksTab As Worksheet
   Dim rngZelle As Range
   Dim arrFarben
   ReDim arrFarben(0 To 3)
   Dim bytZaehler As Byte
   arrFarben = Array(Array("A", "B", "C", "D"), Array(0, 0, 0, 0))
   For Each wksTab In Worksheets
      ' Schleife über alle Diagramm
      For Each chrDia In wksTab.ChartObjects
         With chrDia.Chart
            For lngReihe = 1 To .SeriesCollection.Count
               If InStr(.SeriesCollection(lngReihe).Name, "VB") = 0 Then
                   strReihe = Application.Substitute(Split(.SeriesCollection(lngReihe).Formula, ",")(0), "=SERIES(", "")
                   strReihe = Mid(strReihe, InStr(strReihe, "!") + 1)
                   With .SeriesCollection(lngReihe).Format.Line
                      .Visible = msoTrue
                      .ForeColor.RGB = Worksheets("Daten").Range(strReihe).Interior.Color
                      .Transparency = 0
                   End With
                   ' Farben ins Array schreiben
                   If wksTab.Name = "Diagramm" Then
                     bytZaehler = Application.Match(.SeriesCollection(lngReihe).Name, arrFarben(0), 0) - 1
                     arrFarben(1)(bytZaehler) = Worksheets("Daten").Range(strReihe).Interior.Color
                   End If
               End If
            Next lngReihe
         End With
      Next chrDia
      ' falls nur 1 Diagramm vorhanden
      If wksTab.ChartObjects.Count = 1 Then
         ' ausführen im betreffenden Tabellenblatt
         With wksTab
            ' Position der Farbe im Array ermitteln
            bytZaehler = Application.Match(wksTab.Name, arrFarben(0), 0) - 1
            ' Schleife über alle Zellen im benutzten Bereich
            For Each rngZelle In .UsedRange
               ' laufende Zelle hat Hintergundfarbe, dann färben wie Zelle für den Reihennamen (=Arrayinhalt)
               If rngZelle.Interior.ColorIndex <> xlNone Then .Range(rngZelle.Address).Interior.Color = _
                  arrFarben(1)(bytZaehler)
            Next rngZelle
         End With
      End If
   Next wksTab
End Sub

Ich hoffe, dass dieser Code nun deinen tatsächelichen Vorstellungen entspricht.

Bis später,
Karin

 

Hi Karin,

jap, zu den Vorgaben und Anworten kann ich dir nur recht geben. Es ist für mich nicht so einfach alle Details, die für dich wichtig sind, schriftlich mitzuteilen, da sie für mich selbstverständlich sind. Ich habe jedoch im Zuge des Gefechts gemerkt, dass ich an einer präziseren Ausdrucksweise arbeiten sollte und bedanke mich für deine Geduld! :)

Jetzt passts aber wirklich. Du hast mir sehr geholfen. Das ist eine große Erleichterung für mich.

Ich habe nur noch eine kleine Zusatzfrage:
Die Produkte bekommen diverse Namen wie z.B. WAL_F24R_ROH120M0-F7_W36. Ich habe versucht diese in meiner vollständigen Version mit z.B. A auszutauschen. Der Code hat nicht funktioniert, bis ich die Sonderzeichen entfernt habe. Ich dachte, dass Sonderzeichen in Zeichenketten zwischen Hochkommas ignoriert bzw. wie Buchstaben oder Zahlen gelesen werden. Ist das Generell nicht so? Oder wie verhält sich das?

Lg, Rene

 

Hi Rene,

was meinst du mit Sonderzeichen - die Unterstriche? Schreibe ins Array dieses: "'WAL_F24R_ROH120M0-F7_W36'" - also an den Beginn und ans Ende einen Apostroph. Einfach mal testen.

Bis später,
Karin

 

Hey Karin,

ja, ich hab die Unter- und Bindestriche gemeint. Das mit dem Apostroph hat nicht funktioniert. Doch ich habe beim probieren den Fehler entdeckt. Bei einem Produkt war der Name zu lang für den Blattnamen und ich hab deshalb am Schluss eine 0 weggelassen. Deswegen passten die Namen im Code mit der Zelle im Blatt "Daten" und der Benennung des Produktblattes nicht zusammen.

Also somit auch das geklärt.

TY & Bis bald, Rene