Excel - Cambio de color al clicar un objeto forma

Option Explicit

Sub ula_ula()

Dim obj As Variant, sh As Shape

On Error Resume Next

For Each obj In ActiveSheet.Shapes

    obj.Delete

Next

Set sh = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 0, 0, 100, 100)

With sh

     .Name = "a;0,0,0;255,0,0"

     .OnAction = "OnShapeClic"

     .Fill.ForeColor.rgb = VBA.rgb(0, 0, 0)

End With

Set sh = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 0, 100, 100, 100)

With sh

     .Name = "b;0,0,255;0,255,0"

     .OnAction = "OnShapeClic"

     .Fill.ForeColor.rgb = VBA.rgb(0, 0, 255)

End With

End Sub

Sub OnShapeClic()

Dim sh As Shape, obj As Variant

Dim r$, g$, b$, rgb$

On Error Resume Next

For Each obj In ActiveSheet.Shapes

    If obj.Name = Application.Caller Then

       Set sh = obj

       Exit For

    End If

Next

With sh

     If VBA.Mid(.Name, 1, 1) = "-" Then

        rgb = VBA.Split(.Name, ";")(1)

        .Name = VBA.Mid(.Name, 2)

     Else

         .Name = "-" & .Name

         rgb = VBA.Split(.Name, ";")(2)

     End If

     r = VBA.Split(rgb, ",")(0)

     g = VBA.Split(rgb, ",")(1)

     b = VBA.Split(rgb, ",")(2)

     .Fill.ForeColor.rgb = VBA.rgb(CInt(r), CInt(g), CInt(b))

End With

End Sub