为多个复选框添加VBA - 返回编译错误

Question

我在一张纸上有 70 个复选框。

我想要每个复选框 - 单击以在该复选框周围填充矩形时。 如果未单击复选框 - 矩形将不会填充。

我的问题是我尝试将此代码应用于每个复选框 - 但我收到编译错误："编译错误检测到不明确的名称框检查">

如何防止编译错误？ 注意：每个复选框都有自己唯一的名称 (1-70(，每个矩形都有自己的唯一名称 (1-70(。这样，每个复选框应仅填充 VBA IF/THEN 代码引用的矩形。我不希望 1 个复选框填充所有矩形。

这是我的代码：

Sub BoxCheck()
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
ActiveSheet.Shapes("Rectangle 1").Fill.ForeColor.SchemeColor = 3
End If
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = -4146 Then
ActiveSheet.Shapes("Rectangle 1").Fill.ForeColor.SchemeColor = 1
End If
End Sub

Answer 1

如果模块中有多个名称完全相同的 sub，则可能会抛出错误。如果您复制原始代码或下面的代码，并简单地替换与其相关的矩形和框号的 #，则可能会清除错误。

Sub BoxCheck#()
If ActiveSheet.Shapes("Check Box #").ControlFormat.Value = 1 Then
ActiveSheet.Shapes("Rectangle #").Fill.ForeColor.SchemeColor = 3
End If
If ActiveSheet.Shapes("Check Box #").ControlFormat.Value = -4146 Then
ActiveSheet.Shapes("Rectangle #").Fill.ForeColor.SchemeColor = 1
End If
End Sub

另一种选择是将每个BoxCheck放入不同的模块中，但这似乎太多了，特别是因为您有 70

个

Answer 2

您可以将所有复选框链接到单个 sub，并使用Application.Caller来确定哪个调用了该方法：

Sub BoxCheck()
Dim shp, rectName as string
Set shp = ActiveSheet.Shapes(Application.Caller)
rectName = Replace(Application.Caller, "Check Box ", "Rectangle ")
ActiveSheet.Shapes(rectName).Fill.ForeColor.SchemeColor = _
IIf(shp.ControlFormat.Value = 1, 3, 1)
End Sub