VBA Excel CheckBox 用于选择工作表上的所有特定复选框

VBA Excel CheckBox to select all of some specific Checkboxes on Sheet

提问by Celestial Dragon of Osiris

I have an Excel Sheet with two columns of CheckBoxes of which the first CheckBox of each is the "Master" Checkbox which toggles all other CheckBoxes.
I got the code from This Tutorial.

我有一个带有两列复选框的 Excel 工作表，其中每个复选框的第一个复选框是“主”复选框，它可以切换所有其他复选框。
我从本教程中得到了代码。

It worked fine until i copied the Code into the second Column.
When Activating the first or the Second "Master" CheckBox it activates ALL CheckBoxes.
The First "Master" CheckBox is called "MCB1" the Second is in a Copy of this Code (with another Sub Name) and is Called MCB2.

它工作正常，直到我将代码复制到第二列中。
当激活第一个或第二个“主”复选框时，它会激活所有复选框。
第一个“主”复选框称为“MCB1”，第二个位于此代码的副本中（具有另一个子名称），称为 MCB2。

Here's my Code:

这是我的代码：

Sub SelectAll_Read()
Dim CB As CheckBox
 For Each CB In ActiveSheet.CheckBoxes
  If CB.Name <> ActiveSheet.CheckBoxes("MCB1").Name Then
   CB.Value = ActiveSheet.CheckBoxes("MCB1").Value
  End If
 Next CB
End Sub

Sub Mixed_ReadState()
Dim CB As CheckBox
For Each CB In ActiveSheet.CheckBoxes
  If CB.Name <> ActiveSheet.CheckBoxes("MCB1").Name And CB.Value <> ActiveSheet.CheckBoxes("MCB1").Value And ActiveSheet.CheckBoxes("MCB1").Value <> 2 Then
    ActiveSheet.CheckBoxes("MCB1").Value = 2
Exit For
   Else
     ActiveSheet.CheckBoxes("MCB1").Value = CB.Value
  End If
Next CB
End Sub

回答by hstay

First of all you need to differenciate Checkboxes from Column 1 to those in Column 2.

首先，您需要将第 1 列中的复选框与第 2 列中的复选框区分开来。

For instance you could name follower checkboxes in Column 1 as MCB1.1, MCB1.2, MCB1.3and so on. The same thing for checkboxes in column 2: MCB2.1, MCB2.2, MCB2.3...

例如，你可以将其命名跟随第1栏的复选框为MCB1.1，MCB1.2，MCB1.3等等。第 2 列中的复选框也是如此：MCB2.1, MCB2.2, MCB2.3...

"Master" checkboxes in column 1 and 2 could be named MCB1and MCB2.

第 1 列和第 2 列中的“主”复选框可以命名为MCB1和MCB2。

Then your code needs to be modified as follows: (Didn't have time to test it)

那么你的代码需要修改如下：（没时间测试）

Sub SelectAll_Read()
Dim CB As CheckBox
    For Each CB In ActiveSheet.CheckBoxes
        If CB.Name <> ActiveSheet.CheckBoxes("MCB1").Name And CB.Name <> ActiveSheet.CheckBoxes("MCB2").Name Then
            If Mid(CB.Name, 4, 1) = "1"
                CB.Value = ActiveSheet.CheckBoxes("MCB1").Value
            ElseIf Mid(CB.Name, 4, 1) = "2"
                CB.Value = ActiveSheet.CheckBoxes("MCB2").Value
            End If
        End If
    Next CB
End Sub

Sub Mixed_ReadState()
Dim CB As CheckBox
Dim i As String

    For Each CB In ActiveSheet.CheckBoxes
        i = Mid(CB.Name, 4, 1)
        If CB.Name <> ActiveSheet.CheckBoxes("MCB" & i).Name And CB.Value <> ActiveSheet.CheckBoxes("MCB" & i).Value And  ActiveSheet.CheckBoxes("MCB" & i).Value <> 2 Then
            ActiveSheet.CheckBoxes("MCB" & i).Value = 2
            Exit For
        Else
            ActiveSheet.CheckBoxes("MCB" & i).Value = CB.Value
        End If
    Next CB
End Sub

回答by Yaris

This alternative method worked for me

这种替代方法对我有用

Sub SelectAll_CHECK_BOX()
    Dim CB As CheckBox
    Dim CB1 As Range
        Set CB1 = ActiveSheet.Range("A1:A30")
    For Each CB In ActiveSheet.CheckBoxes
            If Not Intersect(CB.TopLeftCell, CB1) Is Nothing Then
                CB.Value = ActiveSheet.CheckBoxes("MCB1").Value
          End If
    Next CB
    Dim CB2 As Range
        Set CB2 = ActiveSheet.Range("B1:B30")
    For Each CB In ActiveSheet.CheckBoxes
            If Not Intersect(CB.TopLeftCell, CB2) Is Nothing Then
                CB.Value = ActiveSheet.CheckBoxes("MCB2").Value
            End If
    Next CB
End Sub

Sub Mixed_ReadState()
Dim CB As CheckBox
    For Each CB In ActiveSheet.CheckBoxes
        If CB.Name <> ActiveSheet.CheckBoxes("MCB1").Name And CB.Value <> ActiveSheet.CheckBoxes("MCB1").Value And ActiveSheet.CheckBoxes("MCB1").Value <> 2 Then
        ActiveSheet.CheckBoxes("MCB1").Value = 2
        Exit For
        Else
        ActiveSheet.CheckBoxes("MCB1").Value = CB.Value
        End If
    Next CB
End Sub` 



Sub Mixed_ReadState()
Dim CB As CheckBox
    For Each CB In ActiveSheet.CheckBoxes
        If CB.Name <> ActiveSheet.CheckBoxes("MCB2").Name And CB.Value <> ActiveSheet.CheckBoxes("MCB2").Value And ActiveSheet.CheckBoxes("MCB2").Value <> 2 Then
        ActiveSheet.CheckBoxes("MCB2").Value = 2
        Exit For
        Else
        ActiveSheet.CheckBoxes("MCB2").Value = CB.Value
        End If
    Next CB
End Sub