Balkenfarbe in Abhängigkeit von Achsenbeschrift
10.11.2014 11:50:44
Achsenbeschrift
ich habe folgendes (funktionierendes) Script gefunden, welches die Balkenfarbe eines Diagramms entsprechend der Beschriftung der X-Achse anpasst. Die Beschriftung steht in A2 bis E2. Ich möchte diese nun von "zeilenbasiert" auf "spaltenbasiert" (A2:A6) umschreiben. Wahrscheinlich liegt das Problem im zweiten Script irgendwo in dem Bereich von "EndXl...". Über einen Hinweis, warum das zweite Script nicht funktioniert wäre ich sehr dankbar.
Sub Diagramm_formatieren()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim l As Long
a = 0
For l = 1 To Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points.Count
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Point(l).Interior.ColorIndex = 1
Next l
For i = 1 To Worksheets(5).Range("A2").End(xlToRight).Column
Set rng = Worksheets(5).Range("A2").Offset(0, i - 1)
If rng.EntireColumn.Hidden = False Then
If rng.Value = "Rot" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
ElseIf rng.Value = "Gelb" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 44
ElseIf rng.Value = "Blau" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 5
End If
Else
a = a + 1
End If
Next i
End Sub
Sub Diagramm_formatieren()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim l As Long
a = 0
For l = 1 To Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points.Count
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Point(l).Interior.ColorIndex = 1
Next l
For i = 1 To Worksheets(5).Range("A6").End(xlUp).Row
Set rng = Worksheets(5).Range("A6").Offset(0, i - 1)
If rng.EntireRow.Hidden = False Then
If rng.Value = "Rot" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
ElseIf rng.Value = "Gelb" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 44
ElseIf rng.Value = "Blau" Then
Worksheets(5).ChartObjects("Diagramm 1").Chart.
SeriesCollection(1).Points(i - a).Interior.ColorIndex = 5
End If
Else
a = a + 1
End If
Next i
End Sub
Anzeige
