Kontrollkästchen Erweiterung

Sub ColorShapes()
Dim objShp As Shape
On Error GoTo ErrExit
GMS
For Each objShp In ActiveSheet.Shapes
objShp.Fill.Visible = msoTrue
If Left(objShp.Name, 6) = "Option" Or Left(objShp.Name, 5) = "Check" Then
objShp.Fill.ForeColor.RGB = IIf(objShp.DrawingObject.Value = 1, RGB(0, 255, 0), RGB(255, _
0, 0))
End If
Next
ErrExit:
GMS 0
Set objShp = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Integer = 1)
With Application
.ScreenUpdating = Modus  1
.EnableEvents = Modus  1
.DisplayAlerts = Modus  1
.Calculation = IIf(Modus = 1, -4135, -4105)
.Cursor = IIf(Modus = 1, 2, -4143)
End With
End Sub