Liniendiagr. i. Verl. versch. Farben zu ordnen
26.03.2007 14:00:42
Wolfgang
über eine Schaltfläche wird ein Liniendiagramm (Werte stammen aus einer Schleife) aufgebaut.
Dieses Liniendiagramm lässt sich im zeitlichen Verlauf in 3 Abschnitte unterteilen.
Z.B. 1. Abschnitt: Tag 0-4; 2. Abschnitt: Tag 5-13; 3. Abschnitt: Tag 14-20
Jedem dieser Abschnitte soll eine andere Farbe zugewiesen werden.
Ist das machbar?
Und wenn ja, wie?
Kann man das Liniendiagramm "einfärben", nachdem es sich generiert hat?
Oder muss ich den Code für das Generieren des Liniendiagramms ändern und wo, am besten wie?
(anbei der Code für die Schleife und für die Erstellung des Diagramms.)
Danke schon im Voraus für Eure Hilfe!
Wolfgang
Sub DatenAufbereiten()
Dim Tag As Integer, i As Double, wksA As Worksheet, wksB As Worksheet
Set wksA = ActiveWorkbook.Worksheets("Berechnung")
Set wksB = ActiveWorkbook.Worksheets("Schleife")
Sheets("Berechnung").Select
i = 0
Tag = 0
Do Until i = Range("W9")
i = i + 1
wksB.Cells(2 + i, "A") = i
Do Until Tag = Range("W9")
Tag = Tag + 1
wksA.Range("I12").Value = Tag
wksB.Cells(2 + Tag, "B").Value = wksA.Range("T12").Value
Loop
Loop
End Sub
Sub DiagrammErstellen()
Dim Dia As ChartObject
Dim i As Currency
Set Dia = Sheets("DRG Info").ChartObjects.Add(2, 470, 625, 400)
Dia.Name = "DRG"
i = Sheets("Schleife").Range("B3").End(xlDown).Row
Sheets("Schleife").Range("A3:B" & i).Copy
Sheets("DRG Info").ChartObjects("DRG").Activate
ActiveChart.SeriesCollection.Paste _
Rowcol:=xlColumns, SeriesLabels:=False, _
CategoryLabels:=True, Replace:=True, NewSeries:=True
With ActiveChart
.ChartType = xlLineMarkers
.HasLegend = False
.HasTitle = True
.ChartTitle.Characters.Text = "DRG:" & " " & Sheets("Berechnung").Range("A5")
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Tage"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Euro"
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
End Sub