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