Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Diagramm-Linienfarbe stimmt nicht mit Legende
26.01.2017 12:24:13
Oliver
Liebe Excel-VBA Experten,
ich habe folgendes Problem. Nach mehrmaligen aufrufen der Subroutine, ändert sich die Zuordnung der Linienfarbe im Diagramm zur Linienfarbe der Legende und ist somit fehlerhaft. Ich habe schon einiges probiert und bin nun ratlos.
Hier der Code:
Sub Diagram0(chTitle As String)
Dim Dia As ChartObject, rPlotData As Range, rData1 As Range, rData2 As Range, rData3 As Range, _
rData4 As Range
Dim Data1col As Integer, Data2col As Integer, Data3col As Integer, Data4col As Integer
Data1col = Sheets("Logfile1").CBoxData1.ListIndex + 3
Data2col = Sheets("Logfile1").CBoxData2.ListIndex + 3
Data3col = Sheets("Logfile1").CBoxData3.ListIndex + 3
Data4col = Sheets("Logfile1").CBoxData4.ListIndex + 3
On Error Resume Next
ActiveSheet.ChartObjects.Delete
Set Dia = ActiveSheet.ChartObjects.Add(180, 20, 1000, 450)
Dia.Name = "LogDia0"
Set rData1 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data1col), Cells(pRowEndLog1, Data1col)) _
Set rData2 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data2col), Cells(pRowEndLog1, Data2col)) _
Set rData3 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data3col), Cells(pRowEndLog1, Data3col)) _
Set rData4 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data4col), Cells(pRowEndLog1, Data4col)) _
Set rPlotData = Union(rData1, rData2, rData3, rData4)
ActiveSheet.ChartObjects("LogDia0").Activate
With ActiveChart
.ChartType = xlLine
.HasLegend = True
.HasTitle = True
.chartTitle.Text = chTitle
.SeriesCollection.NewSeries
.SetSourceData _
Source:=rPlotData
.SeriesCollection(1).XValues = Range(Cells(Bezuege.rTime.Row, Bezuege.rTime.Column), Cells( _
pRowEndLog1, Bezuege.rTime.Column))
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 400
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Druck [bar] / Temperatur [°C]"
.SeriesCollection(1).Name = Cells(Bezuege.rFirstEntry.Row, Data1col).Value
.SeriesCollection(1).Select
Selection.Border.ColorIndex = 1
.Legend.Select
.Legend.LegendEntries(1).LegendKey.Select
Selection.Border.ColorIndex = 1
.SeriesCollection(2).Name = Cells(Bezuege.rFirstEntry.Row, Data2col).Value
.SeriesCollection(2).Select
Selection.Border.ColorIndex = 3
.Legend.Select
.Legend.LegendEntries(2).LegendKey.Select
Selection.Border.ColorIndex = 3
.SeriesCollection(3).Name = Cells(Bezuege.rFirstEntry.Row, Data3col).Value
.SeriesCollection(3).Select
Selection.Border.ColorIndex = 4
.Legend.Select
.Legend.LegendEntries(3).LegendKey.Select
Selection.Border.ColorIndex = 4
.SeriesCollection(4).Name = Cells(Bezuege.rFirstEntry.Row, Data4col).Value
.SeriesCollection(4).Select
Selection.Border.ColorIndex = 5
.Legend.Select
.Legend.LegendEntries(4).LegendKey.Select
Selection.Border.ColorIndex = 5
End With
Range("A1").Select
End Sub

Danke im Voraus
lg
Oliver

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Diagramm-Linienfarbe stimmt nicht mit Legende
26.01.2017 15:42:39
Oliver
Hatte schon jemand Gelegenheit mal kurz darüber zuschauen?
Ohne Beispielmappe keine Chance (o.w.T)
26.01.2017 19:47:23
Beverly


AW: Ohne Beispielmappe keine Chance (o.w.T)
27.01.2017 06:50:00
Oliver
Guten Morgen!
Hier nun der Code, als auch die Testdaten:
https://www.herber.de/bbs/user/110924.xlsm
https://www.herber.de/bbs/user/110925.zip
Nach dem Einlesen der Daten, stimmen die Diagrammlinienfarben noch mit den Legendenfarben überein. Werden andere Daten über die Comboboxen ausgewählt, kann es sein, dass die Zuordnung nicht mehr stimmt.
Danke
lg
Oliver
Anzeige
Das Problem...
27.01.2017 09:50:32
Beverly
Hi Oliver,
...liegt m.E. darin begründet, dass du - soweit ich feststellen konnt - mal 3 und mal 4 Datenreihen im Diagramm hast. Allerdings konnte ich leider nicht bis ins Detail testen, weil Excel mit deiner Mappe ständig abstürtzt.
Falls meine Feststellung mit der unterschiedlichen Datenreihenanzahl stimmt, würde ich vom Prinzip her so vorgehen, dass ich auch nur 3 Datenreihen ins Diagramm aufneheme, falls nur 3 dargestellt werden sollen, bzw. nur die 4. färben wenn auch 4 vorhanden sind (siehe Code unten die If-Abfrage).
Ich würde auch die Datenreihen selbst und nicht die Legendeneinträge färben, Select und Activate muss man nicht verwenden und beim Löschen der Diagramme kann man auf On Error verzichten, indem man vorher prüft, ob Diagramme vorhanden sind:
Sub Diagram0(chTitle As String)
Dim Dia As ChartObject, rPlotData As Range, rData1 As Range, rData2 As Range, rData3 As Range, _
rData4 As Range
Dim Data1col As Integer, Data2col As Integer, Data3col As Integer, Data4col As Integer
Data1col = Sheets("Logfile1").CBoxData1.ListIndex + 3
Data2col = Sheets("Logfile1").CBoxData2.ListIndex + 3
Data3col = Sheets("Logfile1").CBoxData3.ListIndex + 3
Data4col = Sheets("Logfile1").CBoxData4.ListIndex + 3
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Set Dia = ActiveSheet.ChartObjects.Add(180, 20, 1000, 450)
Dia.Name = "LogDia0"
Set rData1 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data1col), Cells(pRowEndLog1, Data1col)) _
Set rData2 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data2col), Cells(pRowEndLog1, Data2col)) _
Set rData3 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data3col), Cells(pRowEndLog1, Data3col)) _
Set rData4 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data4col), Cells(pRowEndLog1, Data4col)) _
Set rPlotData = Union(rData1, rData2, rData3, rData4)
With ActiveSheet.ChartObjects("LogDia0").Chart
.ChartType = xlLine
.HasLegend = True
.HasTitle = True
.chartTitle.Text = chTitle
.SeriesCollection.NewSeries
.SetSourceData _
Source:=rPlotData
.SeriesCollection(1).XValues = Range(Cells(Bezuege.rTime.Row, Bezuege.rTime.Column), Cells( _
pRowEndLog1, Bezuege.rTime.Column))
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 400
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Druck [bar] / Temperatur [°C]"
.SeriesCollection(1).Name = Cells(Bezuege.rFirstEntry.Row, Data1col).Value
.SeriesCollection(1).Border.ColorIndex = 1
.SeriesCollection(2).Name = Cells(Bezuege.rFirstEntry.Row, Data2col).Value
.SeriesCollection(2).Border.ColorIndex = 3
.SeriesCollection(3).Name = Cells(Bezuege.rFirstEntry.Row, Data3col).Value
.SeriesCollection(3).Border.ColorIndex = 4
' nur wenn 4 Dateneriehn vorhanden sind
If .SeriesCollection.Count = 4 Then
.SeriesCollection(4).Name = Cells(Bezuege.rFirstEntry.Row, Data4col).Value
.SeriesCollection(4).Border.ColorIndex = 5
End If
End With
End Sub


Anzeige
AW: Das Problem...
27.01.2017 10:08:13
Oliver
Hi Karin,
danke für das schnelle Feedback. Über eine Messagebox: MsgBox .SeriesCollection.Count habe ich die Anzahl überprüft. Warum sollten manchmal nur drei Reihen dargestellt werden? (Autoscale auf der y-Achse einstellen)
Die Legendeneinträge habe ich vorerst auch nicht eingefärbt, das war quasi meine letztee Idee!
Also ich werde nicht schlau, was da passiert....
lg
Oliver
AW: Das Problem...
27.01.2017 10:27:24
Beverly
Hi Oliver,
ich habe mal in der oberen ComboBox den 3. Eintrag ausgewählt - dann sind nur noch 3 Datenreihen im Diagramm und diese 3 Datenereihen werden mit den ersten 3 Farben Schwarz (1), Rot (3), Grün (4) gefärbt, obwohl sie eigentlich anders gefärbt werden sollen - ich nehme an Rot (3), Grün (4) und Blau (5)?. Dass der Code auf einen Fehler läuft, wenn die 4. Datenreihe gefärbt werden soll obwohl nur 3 da sind, merkst du nicht, da du unnötigerweise On Error Resume Next verwendest.
Mir ist ja nicht bekannt, welche Datenreihen welche Farbe erhalten sollen, deshalb kann ich die auch nicht genau sage, wie du da vorgehen musst, aber eine Möglichkeit wäre, die Spaltenüberschrift in Zeile 39 in der entsprechenden Farbe zu formatieren und die Datenreihenfarbe daraus zu entnehmen.


Anzeige
AW: Das Problem...
27.01.2017 12:41:15
Oliver
Hi Karin,
ich habe deine Vorschläge alle umgesetzt. Z.b probiere mal in meinem Programm in der letzten Combobox die ,,Zylinderzone 5'' auszuwählen. Dann hat auf einmal die Zylinderzone fälschlicherweise die Farbe des ,,Massedrucks vor Sieb". Und die "Massetemp." hat auf einmal die Farbe der "Zylinderzone".
Ich versteh nicht was Excel da macht....
Danke für deine Hilfe!
lg
Oliver
AW: Das Problem...
27.01.2017 12:44:50
Beverly
Hi Oliver,
da müsstest du schon deine geänderte Mappe hochladen (am besten gleich mit den importierten Daten und Diagrammen direkt nach dem Import).


Anzeige
AW: Das Problem...
27.01.2017 13:32:37
Beverly
Hi Oliver,
die Reihenfolge der Spalten ändert sich doch in Abhängigkeit von der Auswahl in den ComboBoxen und in dieser veränderten Reihenfolge werden deine Datenreihen erstellt und auch farblich formatiert. Aufgefallen ist mir z.B., dass im korrekten Diagramm die Zuordnung des Datenreihennamen zur betreffenden Spalte, aus der die Daten stammen, übereinstimmen:
Z zu Z
AB zu AB
AC zu AC
AG zu AG
Im falsch formatierten Diagramm dagegen stimmen diese nicht überein:
H zu Z
Z zu AB
AB zu AC
AC zu H
Irgendetwas stimmt also etwas bei der Zuweisung des Wertebereichs nicht.
Hast du denn schon mal versucht, die Spaltenüberschriften mit der gewünschten Farbe zu versehen und die Farbe dann daraus auszulesen? Ich denke, das ist der einfachste Weg. Dabei solltest du aber die Datenreihen einzeln erstellen und nicht den Gesamtbereich mittels SetSourceData zuweisen.


Anzeige
AW: Das Problem...
29.01.2017 08:22:12
Oliver
Morgen Karin,
vielen, vielen Dank für deinen Input, du hast mir sehr weitergeholfen!
Ich habe den Befehl Union nicht ganz durchschaut und habe das Problem nun wie folgt gelöst:
Sub Diagram0(chTitle As String)
Dim Dia As ChartObject, rPlotData As Range, rData1 As Range, rData2 As Range, rData3 As Range, _
rData4 As Range
Dim Data1col As Integer, Data2col As Integer, Data3col As Integer, Data4col As Integer
Dim i As Integer
i = 1
Data1col = Sheets("Logfile1").CBoxData1.ListIndex + 3
Data2col = Sheets("Logfile1").CBoxData2.ListIndex + 3
Data3col = Sheets("Logfile1").CBoxData3.ListIndex + 3
Data4col = Sheets("Logfile1").CBoxData4.ListIndex + 3
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Set Dia = ActiveSheet.ChartObjects.Add(180, 20, 1000, 450)
Dia.Name = "LogDia0"
Set rData1 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data1col), Cells(pRowEndLog1, Data1col)) _
Set rData2 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data2col), Cells(pRowEndLog1, Data2col)) _
Set rData3 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data3col), Cells(pRowEndLog1, Data3col)) _
Set rData4 = Range(Cells(Bezuege.rFirstEntry.Row + 1, Data4col), Cells(pRowEndLog1, Data4col)) _
With ActiveSheet.ChartObjects("LogDia0").Chart
.ChartType = xlLine
.HasLegend = True
.HasTitle = True
.chartTitle.Text = chTitle
.SeriesCollection.NewSeries
.SetSourceData _
Source:=rData1
.SeriesCollection(i).XValues = Range(Cells(Bezuege.rTime.Row, Bezuege.rTime.Column), Cells( _
pRowEndLog1, Bezuege.rTime.Column))
.SeriesCollection(i).Name = Cells(Bezuege.rFirstEntry.Row, Data1col).Value
.SeriesCollection(i).Border.ColorIndex = 1
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScaleIsAuto = True
'.Axes(xlValue).MinimumScaleIsAuto = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Druck [bar] / Temperatur [°C]"
If Sheets("Logfile1").CheckBoxData2 Then
i = i + 1
.SeriesCollection.Add Source:=rData2
.SeriesCollection(i).Name = Cells(Bezuege.rFirstEntry.Row, Data2col).Value
.SeriesCollection(i).Border.ColorIndex = 3
End If
If Sheets("Logfile1").CheckBoxData3 Then
i = i + 1
.SeriesCollection.Add Source:=rData3
.SeriesCollection(i).Name = Cells(Bezuege.rFirstEntry.Row, Data3col).Value
.SeriesCollection(i).Border.ColorIndex = 4
End If
If Sheets("Logfile1").CheckBoxData4 Then
i = i + 1
.SeriesCollection.Add Source:=rData4
.SeriesCollection(i).Name = Cells(Bezuege.rFirstEntry.Row, Data4col).Value
.SeriesCollection(i).Border.ColorIndex = 5
End If
End With
Range("A1").Select
End Sub

GLG
Oliver
Anzeige
Freut mich dass ich helfen konnte - o.w.T
29.01.2017 09:37:12
Beverly


105 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige