Diagramm Farbänderung verhindern
28.09.2005 13:11:15
Moe
ich habe ein Problem mit einem Makro bei dem man mit zwei Comboboxen Werte auswählen kann und ein Diagramm hat dass sich bei jeder Änderung(auch nur eines Wertes)dementsprechend aktualisiert. Das Makro an sich funktioniert auch ohne Probleme aber die "Diagrammstriche" ändern bei jeder Ändeung ihre Farbe, was ich aber auf keinen Fall will.
Ich poste hier den Code gleich mit und währe über jede Hilfe sehr erfreut.
Mit freundlichen Grüßen
Moe
Code:
Sub DiagramCreator1()
ThisWorkbook.Activate
Reihe1 = Worksheets(1).Range("AD3")
Worksheets("Tabelle1").ChartObjects("Diagramm 1").Activate
Application.CutCopyMode = False
If Dia1 = True Then
Worksheets("Tabelle1").ChartObjects("Diagramm 1").Chart. _
SeriesCollection(1).Delete
End If
ActiveChart.SeriesCollection.Add Source:=Sheets(1).Range("$A$" & Reihe1 & ":$S$" & Reihe1) _
, Rowcol:=xlRows, SeriesLabels:=True, CategoryLabels:=False, Replace _
:=True
Dia1 = True
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlSquare
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
'ActiveChart.SeriesCollection(1).XValues = "=Tabelle1 (2)!R4C2:R4C19"
Worksheets(2).Cells(1, 1).Activate
End Sub
Sub DiagramCreator2()
ThisWorkbook.Activate
Reihe2 = Worksheets(1).Range("AD4")
Worksheets("Tabelle1").ChartObjects("Diagramm 1").Activate
Application.CutCopyMode = False
If Dia2 = True Then
Worksheets("Tabelle1").ChartObjects("Diagramm 1").Chart. _
SeriesCollection(1).Delete
End If
ActiveChart.SeriesCollection.Add Source:=Sheets(1).Range("$A$" & Reihe2 & ":$S$" & Reihe2) _
, Rowcol:=xlRows, SeriesLabels:=True, CategoryLabels:=False, Replace _
:=True
Dia2 = True
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 5
.MarkerForegroundColorIndex = 5
.MarkerStyle = xlSquare
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
'ActiveChart.SeriesCollection(2).XValues = "=Tabelle1 (2)!R4C2:R4C19"
Worksheets(2).Cells(1, 1).Activate
End Sub
Anzeige