VBA Excel CheckBox选择Sheet上的所有特定复选框

时间:2014-03-13 10:25:27

标签: excel vba excel-vba checkbox

我有一张带有两列CheckBox的Excel表格,其中每列的第一个CheckBox是“Master”复选框,可以切换所有其他CheckBox。 我从This Tutorial获得了代码。

在将代码复制到第二列之前,它工作正常 当激活第一个或第二个“主”复选框时,它会激活所有复选框 第一个“主”CheckBox被称为“MCB1”,第二个在此代码的副本中(带有另一个子名称),被称为MCB2。

这是我的代码:

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

2 个答案:

答案 0 :(得分:1)

首先,您需要将Checkbox从第1列区分为第2列中的复选框。

例如,您可以将第1列中的关注者复选框命名为MCB1.1MCB1.2MCB1.3,依此类推。第2列中的复选框也是如此:MCB2.1MCB2.2MCB2.3 ......

第1列和第2列中的“主要”复选框可以命名为MCB1MCB2

然后你的代码需要修改如下:(没时间测试它)

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

答案 1 :(得分:1)

这种替代方法对我有用

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