Hallo,

um den Aufwand bei mehreren Ampeln gering zu halten, habe ich den VBA-Code überarbeitet:

Enum Flag
    aus = 0
    Rot = 1
    RotGelb = 3
    Gruen = 4
    Gelb = 2
End Enum

Sub Ampel(Status As Flag, Ampel As String)
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If Left(sh.Name, Len(Ampel)) = Ampel Then
            ' Grün
            With sh.Fill
                Select Case LCase(Right(sh.Name, Len(sh.Name) - Len(Ampel)))
                    Case "gruen"
                        If (Status And Flag.Gruen) = Flag.Gruen Then
                            .ForeColor.SchemeColor = 11
                            .Visible = msoTrue
                            .Solid
                        Else
                            .ForeColor.SchemeColor = 9
                        End If
                    Case "gelb"
                        If (Status And Flag.Gelb) = Flag.Gelb Then
                            .ForeColor.SchemeColor = 13
                            .Visible = msoTrue
                            .Solid
                        Else
                            .ForeColor.SchemeColor = 9
                        End If
                    Case "rot"
                        If (Status And Flag.Rot) = Flag.Rot Then
                            .ForeColor.SchemeColor = 10
                            .Visible = msoTrue
                            .Solid
                        Else
                            .ForeColor.SchemeColor = 9
                        End If
                    Case Else
                End Select
            End With
        End If
    Next
End Sub


Sub Ampel1Gruen()
    Ampel Flag.Gruen, "1"
End Sub

Sub Ampel1Gelb()
    Ampel Flag.Gelb, "1"
End Sub

Sub Ampel1Rot()
    Ampel Flag.Rot, "1"
End Sub

Sub Ampel2Gruen()
    Ampel Flag.Gruen, "2"
End Sub

Sub Ampel2Gelb()
    Ampel Flag.Gelb, "2"
End Sub

Sub Ampel2Rot()
    Ampel Flag.Rot, "2"
End Sub

Hierbei wird die eigentliche Zuweisung in nur einem Sub Befehl durchgeführt.

Eine Beispiel-Arbeitsmappe kann hier heruntergeladen werden.

LG, BigBen