我正在尝试制作一个最喜欢的按钮,但我正在尝试使按钮没有填充,并在单击时显示填充。我还设置了一个按钮来插入星星。下面的代码:
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)下面评论中建议的更改。目前我试图不通过它的特定名称来引用星形,而是通过它在第一个子例程中定义的变量来引用它。所以我的问题是如何使变量成为全局变量,以便不同的子例程可以引用它
最佳答案
更新代码 - 在黄色和透明填充之间切换:
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
关于Excel VBA : If statement with shape fill (favourite button),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/57221062/