Excel VBA : If statement with shape fill (favourite button)

Question

我正在尝试制作一个最喜欢的按钮，但我正在尝试使按钮没有填充，并在单击时显示填充。我还设置了一个按钮来插入星星。下面的代码:

Sub favourite_btn()

Dim star_shp As Shape

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double


Set cl = Range("A1")


With star_shp
    clLeft = cl.Left
    clTop = cl.Top
    clWidth = 50
    clHeight = 50
End With

Set star_shp = ActiveSheet.Shapes.AddShape(msoShape5pointStar, clLeft, clTop, clWidth, clHeight)

    With star_shp
        .Line.Visible = msoTrue
        '.Fill.Visible = msoFalse
        .Fill.ForeColor.RGB = 16777215
    End With


End Sub

Sub star_fill()

Set ws3 = Sheets("Sheet1")
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes("5-Point Star 7")
    Dim test As String

    Debug.Print shp.Fill.ForeColor.RGB

    If shp.Fill.ForeColor.RGB = 16777215 Then 'if it is transparent
        shp.Fill.ForeColor.RGB = 65535 'make it yellow
        test = ws3.Shapes(Application.Caller).TopLeftCell.Offset(0, 1).Value
        MsgBox test
    Else
        shp.Fill.ForeColor.RGB = 16777215 'otherwise back to transparent
    End If




End Sub

当我单击星号时出现错误(触发star_fill宏“指定集合的​​索引超出范围”并突出显示star_Fill子中的 "Set shp = ActiveSheet.Shapes(star_shp)"行。我认为这是因为我没有' t 将 star_shp 变量设置为公共(public)变量，但我这样做了，它仍然会引发此错误。

有任何想法吗？将不胜感激任何帮助!谢谢

编辑:更新了我的代码以反射(reflect)下面评论中建议的更改。目前我试图不通过它的特定名称来引用星形，而是通过它在第一个子例程中定义的变量来引用它。所以我的问题是如何使变量成为全局变量，以便不同的子例程可以引用它

Answer 1

更新代码 - 在黄色和透明填充之间切换:

Sub star_fill()
    Dim shp As Shape
    Set shp = ActiveSheet.Shapes("5-Point Star 4")

    Debug.Print shp.Fill.ForeColor.RGB

    If shp.Fill.ForeColor.RGB = 16777215 Then 'if it is transparent
        shp.Fill.ForeColor.RGB = 65535 'make it yellow
    Else
        shp.Fill.ForeColor.RGB = 16777215 'otherwise back to transparent
    End If
End Sub

更新#2:

仅当您在 Sub 之外指定公共(public)变量时，它才会起作用。例程(如果嵌入在例程中，变量值总是在给定例程中生存和消亡)。因此，您需要执行以下操作:

Public star_shp as Shape

Sub favourite_btn()
...

但是，公共(public)变量方法不是防错的，因为它也可能丢失对形状的引用(例如，关闭和打开文件)。

另一种方法是有一个创建形状的例程(如您的 favourite_btn 子)和一个完全独立的例程来指示形状的行为。下面的示例适用于您的例程创建的任何形状，即使您的例程用于创建多个(不同)形状。

注意使用:

.OnAction = "star_fill"它将您的 star_fill 子例程分配给创建的形状。

Application.Caller用于将用户选择的形状绑定(bind)到子程序 star_fill .多亏了这一行，我们不再需要创建公共(public)变量 star_shp .

    Sub favourite_btn()
        Dim star_shp    As Shape
        Dim clLeft      As Double
        Dim clTop       As Double
        Dim clWidth     As Double
        Dim clHeight    As Double
        Dim cl          As Range

        Set cl = Range("A1")

        Set star_shp = ActiveSheet.Shapes.AddShape(msoShape5pointStar, cl.Left, cl.Top, 50, 50)

        With star_shp
            .Line.Visible = msoTrue
            '.Fill.Visible = msoFalse
            .Fill.ForeColor.RGB = 16777215
            .OnAction = "star_fill"
        End With

    End Sub

    Sub star_fill()
        Dim star_shp    As Shape

        On Error Resume Next
            Set star_shp = ActiveSheet.Shapes(Application.Caller)
        On Error GoTo 0

        If Not star_shp Is Nothing Then
            If star_shp.Fill.ForeColor.RGB = 16777215 Then 'if it is transparent
                star_shp.Fill.ForeColor.RGB = 65535 'make it yellow
            Else
                star_shp.Fill.ForeColor.RGB = 16777215 'otherwise back to transparent
            End If
        End If
    End Sub