在给定条件的情况下阻止 Excel 中的复选框

Blocking checkboxes in excel given a condition

提问人：Paolo Ruben 提问时间：11/17/2023 最后编辑：braXPaolo Ruben 更新时间：11/19/2023 访问量：60

问：

我正在 excel 上构建一个多项选择“测试”，对可以选择的选项数量有限制，但我编写的代码非常有问题，你能帮我吗？我正在使用的复选框是在 excel 的开发人员选项卡上找到的 activex（我知道我甚至没有尝试缩短它，我对此非常陌生）

Private Sub CheckBox1_Click()
    If CheckBox1.Value = True Then Range("E20").Value = 1
    If CheckBox1.Value = False Then Range("E20").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox1.Enabled = True
    Else
        CheckBox1.Enabled = False
    End If
End Sub

Private Sub CheckBox2_Click()
    If CheckBox2.Value = True Then Range("E21").Value = 1
    If CheckBox2.Value = False Then Range("E21").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox2.Enabled = True
    Else
        CheckBox2.Enabled = False
    End If
End Sub

Private Sub CheckBox3_Click()
    If CheckBox3.Value = True Then Range("E22").Value = 1
    If CheckBox3.Value = False Then Range("E22").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox3.Enabled = True
    Else
        CheckBox3.Enabled = False
    End If
End Sub

Private Sub CheckBox4_Click()
    If CheckBox4.Value = True Then Range("E23").Value = 1
    If CheckBox4.Value = False Then Range("E23").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox4.Enabled = True
    Else
        CheckBox4.Enabled = False
    End If
End Sub

Private Sub CheckBox5_Click()
    If CheckBox5.Value = True Then Range("E24").Value = 1
    If CheckBox5.Value = False Then Range("E24").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox5.Enabled = True
    Else
        CheckBox5.Enabled = False
    End If
End Sub

Private Sub CheckBox6_Click()
    If CheckBox6.Value = True Then Range("E25").Value = 1
    If CheckBox6.Value = False Then Range("E25").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox6.Enabled = True
    Else
        CheckBox6.Enabled = False
    End If
End Sub

Private Sub CheckBox7_Click()
    If CheckBox7.Value = True Then Range("E26").Value = 1
    If CheckBox7.Value = False Then Range("E26").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox7.Enabled = True
    Else
        CheckBox7.Enabled = False
    End If
End Sub

Private Sub CheckBox8_Click()
    If CheckBox8.Value = True Then Range("E27").Value = 1
    If CheckBox8.Value = False Then Range("E27").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox8.Enabled = True
    Else
        CheckBox8.Enabled = False
    End If
End Sub

Private Sub CheckBox9_Click()
    If CheckBox9.Value = True Then Range("E28").Value = 1
    If CheckBox9.Value = False Then Range("E28").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox9.Enabled = True
    Else
        CheckBox9.Enabled = False
    End If
End Sub

Private Sub CheckBox10_Click()
    If CheckBox10.Value = True Then Range("E29").Value = 1
    If CheckBox10.Value = False Then Range("E29").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox10.Enabled = True
    Else
        CheckBox10.Enabled = False
    End If
End Sub

Private Sub CheckBox11_Click()
    If CheckBox11.Value = True Then Range("E30").Value = 1
    If CheckBox11.Value = False Then Range("E30").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox11.Enabled = True
    Else
        CheckBox11.Enabled = False
    End If
End Sub

Private Sub CheckBox12_Click()
    If CheckBox12.Value = True Then Range("E31").Value = 1
    If CheckBox12.Value = False Then Range("E31").Value = 0
    If Range(“C19”).Value <= Range(“E13”).Value Then
        CheckBox12.Enabled = True
    Else
        CheckBox12.Enabled = False
    End If
End Sub
Private Sub CheckBox_Click()
    ' Refresh the worksheet
    ActiveSheet.RefreshAll
End Sub**your text**

我尝试运行此代码并出现错误：运行时错误 1004 出现我不知道那是什么或如何解决它。我试着让聊天 gpt 调试它，但没有运气。

Excel VBA

评论

1赞 Tim Williams 11/17/2023
Range(“C19”).Value <= Range(“E13”).Value您这里有“智能引号”——它们需要更改为常规的双引号。
0赞 Tim Williams 11/17/2023
一旦你达到复选框的限制，你需要禁用工作表上所有其他未被选中的框：仅仅禁用被点击的复选框是不够的（事实上，你不应该禁用复选框，因为你的用户需要能够取消选中一个，如果他们想选择不同的选项）。
0赞 Paolo Ruben 11/17/2023
好的，谢谢！！更改了引号，关于阻塞部分，有没有办法在不为每个框编写 11 个启用语句的情况下做到这一点？我觉得它会变得非常麻烦
0赞 Paolo Ruben 11/17/2023
我恍然大悟......这难道不会使用户在达到限制后无法更改他们的答案吗？
0赞 Tim Williams 11/18/2023
诀窍是，如果他们想在达到限制后更改某些内容，则需要取消选中复选框 - 这应该会触发所有未选中的框重新启用。

答：

0赞 igittr 11/17/2023 #1 
' place this above all code, outside of any sub
Dim nCkCount As Integer, bExit As Boolean
Const nMaxCount As Integer = 5  ' your max allowed answers

' change each check box click event to only contain this code
' the reference to the check box and cell would be unique in each click event, ie E20

Private Sub CheckBox1_Click()
    manageClicks CheckBox1, "E29"
End Sub
' example of second check box...

Private Sub CheckBox2_Click()
    manageClicks CheckBox2, "E30"
End Sub

'add this sub to the code
Private Sub manageClicks(CkBx As Object, sCell As String)
    If bExit Then Exit Sub
    If nCkCount >= nMaxCount Then
        If CkBx.Value Then
            bExit = True ' to bypass this code with reset
            CkBx.Value = False
            bExit = False
            Exit Sub
        End If
    End If
    If CkBx.Value Then
        Range(sCell).Value = 1
        nCkCount = nCkCount + 1
    Else
        Range(sCell).Value = 0
        nCkCount = nCkCount - 1
    End If
End Sub

评论

0赞 Paolo Ruben 11/19/2023
我无法让它工作......我错过了什么？
0赞 igittr 11/19/2023
它是如何失败的，问题是什么，是否有错误？您确定您修改了每个点击事件（如示例所示）吗？
0赞 Paolo Ruben 11/20/2023
没有错误，它只是不会阻止其他复选框
0赞 igittr 11/20/2023
查看代码，围绕 max count 和 ck count 变量。这就是它用来阻止其他复选框的方法。那里的定义一定不正确。
0赞 Paolo Ruben 11/21/2023
我和另一个人一起去了，但无论如何都要感谢，我不能因为缺乏声誉而投票，但仍然......
0赞 Tim Williams 11/18/2023 #2

我可能会使用这样的东西（在工作表代码模块中）：

Option Explicit

Private colCB As Collection 'for capturing clicks...

'sets up the checkbox click capture...
Private Sub Worksheet_Activate()
    Dim obj As Object
    Set colCB = New Collection
    For Each obj In AllCheckBoxes
        colCB.Add cbWrapper(obj)
    Next obj
End Sub

'return an instance of clsCB
Private Function cbWrapper(obj As Object) As clsCB
    Set cbWrapper = New clsCB
    Set cbWrapper.cb = obj
End Function

'all your checkbox click events just call this
Sub ReviewCheckboxes()
    'Const MAX_CHECKED As Long = 4 'or read this from a cell

    Dim maxChecked A Long
    Dim obj, checkedCB As New Collection, uncheckedCB As New Collection
    
    maxChecked = Me.Range("E13").Value
    For Each obj In AllCheckBoxes 'loop all checkboxes on the sheet
        'add to checked/unchecked collection
        If obj.Value = True Then checkedCB.Add obj
        If obj.Value = False Then uncheckedCB.Add obj
    Next obj
    Debug.Print "Checked:", checkedCB.Count, "Unchecked:", uncheckedCB.Count
    
    For Each obj In uncheckedCB 'process unchecked checkboxes
        'disable unchecked checkboxes if limit is reached
        obj.Enabled = checkedCB.Count < MAX_CHECKED
    Next obj
End Sub

'return a collection of all checkboxes on the worksheet
Private Function AllCheckBoxes() As Collection
    Dim obj As Object
    Set AllCheckBoxes = New Collection
    For Each obj In Me.OLEObjects 'loop all OLE controls on the sheet
        If TypeName(obj.Object) = "CheckBox" Then AllCheckBoxes.Add obj.Object 'is this a checkbox?
    Next obj
End Function

添加一个名为“clsCB”的新类模块，并在模块的“属性”中设置为 。将此代码添加到类模块中：Instancing2-PulblicNotCreatable

Option Explicit

Public WithEvents cb As MSForms.CheckBox

Private Sub cb_Click()
    Debug.Print "Clicked", cb.Name
    Sheet1.ReviewCheckboxes 'sheet1 is the *codename* for the worksheet
End Sub

该类存在，因此您不需要为工作表上的每个复选框编写单独的处理程序。Google“VBA控制数组”，如果您想了解有关此方法的更多信息。Click

评论

0赞 Paolo Ruben 11/19/2023
如何让它从单元格中读取？我使用了'Range（“E13”）。值“，但它不起作用，它想要一个固定的值。
0赞 Paolo Ruben 11/19/2023
另外，如何添加“ActiveSheet.RefreshAll”，这样我就不必每次都重新初始化宏？
0赞 Tim Williams 11/19/2023
更新为显示从单元格读取“maxchecked”。我不确定何时需要重新初始化宏？打开工作簿时。
0赞 Tim Williams 11/20/2023
如果你不想使用基于类的方法，那么你可以为每个复选框设置一个点击处理程序，它只是调用ReviewCheckboxes
0赞 Paolo Ruben 11/21/2023
最后，如何打印 cb 值？

上一个：将多列并合并为一列

下一个：如何修复范围值的运行时错误 13 不匹配？