Sekundärachse für Grafiken über makro formatieren

[mort92]

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

[schauan]

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.