Clever-Excel-Forum

Hallo zusammen,

ich möchte gerne über ein Makro die Sekundärachsen für etliche Charts ändern.
Wenn das Blatt "Databasis_Graphics_KPI den Wert 5 in bestimmten Zellen enthält, soll die Formatierung für die Sekundärachse entsprechend so aussehen:
"0,0#pp"

Bei dem Wert 2, soll die Achse wie folgt formatiert werden:
"0,0%"

Mein Code sieht folgendermaßen aus:

Code:
Sub Sekundärachse_KPI()

For Each ChartObject In ActiveSheet.ChartObjects

ChartObject.Activate

    If Sheets("Databasis_Graphics_KPI").Range("b6, b12, b18, b24, b30, b36, b42, b48, b54, b60, b66, b72, b78, b84, b90, b96, b102, b108, b114, b120, b126, b132, b139, b146, b152, b158, b164") = 5 Then

    Sheets("Graphics_KPI").Select

    ActiveSheet.Shapes.Range(Array("Diagramm 2, Diagramm 3, Diagramm 22, Diagramm 26, Diagramm 31, Diagramm 33, Diagramm 38")).Select

    ActiveCharts.Axes(xlValue, xlSecondary).Select

    Selection.TickLabels.NumberFormat = "0,0#pp"

    End If

    If Sheets("Databasis_Graphics_KPI").Range("b6, b12, b18, b24, b30, b36, b42, b48, b54, b60, b66, b72, b78, b84, b90, b96, b102, b108, b114, b120, b126, b132, b139, b146, b152, b158, b164") = 2 Then  '

    Sheets("Graphics_KPI").Select

    ActiveSheet.Shapes.Range(Array("Diagramm 1, Diagramm 4, Diagramm 5, Diagramm 6, Diagramm 8, Diagramm 7, Diagramm 9, Diagramm 10, Diagramm 11, Diagramm 38, Diagramm 23, Diagramm 24, Diagramm 25, Diagramm 27, Diagramm, Diagramm 28, Diagramm 29, Diagramm 30, Diagramm 31, Diagramm 32, Diagramm 34, Diagramm 35, Diagramm 36, Diagramm 37")).Select

    ActiveCharts.Axes(xlValue, xlSecondary).Select

    Selection.TickLabels.NumberFormat = "0,0%"

    End If

    Next

End Sub

Wenn ich ausführe, rattert er auch, allerdings ohne eine Fehlermeldung auszugeben (und ohne die Sekundärachse anzupassen)

Wo liegt mein (wahrscheinlich doofer) Fehler?

Besten Dank und Grüße,

Thorben

Hallo Thorben,

hast Du Dir denn schon mal angeschaut, wo der Code "durchrattert"? Schaue mal nach und mache dann das:

Erstelle Dir mal in einer neuen Datei ein kleines Testmakro

Code:
Sub test()

MsgBox Range("a1,b1,c1") = 0

End Sub

und starte es. Dann schreibe nur in C1 eine 1 und lasse es nochmal laufen.

mort92

schauan