Excel VBA - 循环表单控件复选框不起作用答案

【问题标题】：Excel VBA - loop through Form Control checkbox not workingExcel VBA - 循环表单控件复选框不起作用
【发布时间】：2017-08-21 16:43:38
【问题描述】：

因此，无论出于何种原因，我都无法让我的 VBA 代码循环遍历工作表上的表单控件复选框，以便拥有一个“全选”复选框。我遇到了以下两种不同的方法，据说可以做到这一点：

方法一：

Sub SelectAll_Click()

Dim CB As CheckBox
For Each CB In ActiveSheet.CheckBoxes
  If CB.Name = ActiveSheet.CheckBoxes("cbSiteAll").Name Then
    MsgBox CB.Name & ": " & CB.Value, vbOKOnly
    CB.Value = ActiveSheet.CheckBoxes("cbSiteAll").Value
  Else
    MsgBox CB.Name & ": " & CB.Value, vbOKOnly
  End If
Next CB
End Sub

方法二：

Sub SelectAll_Click()

Dim CB As Shape
Dim sh As Worksheet

Set sh = ActiveSheet
For Each CB In sh.Shapes
  If CB.Type = msoFormControl Then
    If CB.FormControlType = xlCheckBox Then
      MsgBox CB.Name, vbOKOnly
      If CB.Name <> Application.ActiveSheet.CheckBoxes("cbSiteAll").Name Then
        CB.Value = Application.ActiveSheet.CheckBoxes("cbSiteAll").Value
        MsgBox xCheckBox.Name & ": " & xCheckBox.Value, vbOKOnly
      End If
    End If
  End If
Next CB
End Sub

我输入的消息框尝试调试正在发生的事情。对于上述两种情况，循环开始，但我得到的唯一消息框与我勾选的我分配了宏的框有关。它似乎没有遍历任何其他复选框（尽管复选框的验证工作作为循环至少将选中/未选中的项目识别为复选框。

鉴于上述情况，我不知道为什么其中任何一个都不起作用，我花了相当多的时间寻找解决这个特定问题的答案，并通过逻辑对自己进行了研究，但无济于事。唉，我把它交给互联网，看看他们是否能提供帮助。

提前致谢。

【问题讨论】：

如果您将CB.Value 更改为Application.ActiveSheet.CheckBoxes(CB.Name).Value，并且（根据您的子例程名称判断）可能将"cbSiteAll" 更改为"SelectAll"，则方法2 将起作用。我不经常使用表单控件来知道这是否是最简单的方法，但我知道它对我有用。
谢谢。一旦我让循环正常工作，我就会谈到这一点。结果是因为我的复选框被分组，代码没有循环通过它们。不知道为什么，但它似乎解决了我遇到的循环问题。
如果您将 If CB.Name = ActiveSheet.CheckBoxes("cbSiteAll").Name Then 更改为 If CB.Name <> ActiveSheet.CheckBoxes("cbSiteAll").Name Then，方法 1 将起作用 - 您只是将 "cbSiteAll" 复选框的值更改为自身。
Metod2 会起作用。但是 MsgBox xCheckBox.Name & ": " & xCheckBox.Value, vbOKOnly 不好。 MsgBox CB.Name & ": " & CB.Value, vbOKOnly 合适。

标签： excel vba

【解决方案1】：

为了其他看到这篇文章的人的利益，Shape 对象包含一个GroupItems 属性。这个属性，它仍然是一个Shape 对象，实际上是一个Shapes (https://msdn.microsoft.com/VBA/Excel-VBA/articles/shape-groupitems-property-excel) 的集合。因此，当您迭代 Shapes 列表时，您将只能访问“顶级”形状；换句话说，分组形状只能通过GroupItems 属性访问。

如果您希望将工作表上的形状分组并包含在 For Each... 循环中，那么一种解决方案是递归迭代。类似于下面的代码：

Option Explicit

Public Sub RunMe()
    RecursiveLoop Sheet1.Shapes
End Sub

Private Sub RecursiveLoop(col As Object)
    Dim shp As Shape

    For Each shp In col
        If IsGrouped(shp) Then
            RecursiveLoop shp.GroupItems
        Else
            Debug.Print shp.Name
        End If
    Next
End Sub

Private Function IsGrouped(shp As Shape) As Boolean
    Dim grp As GroupShapes

    On Error Resume Next
    Set grp = shp.GroupItems
    On Error GoTo 0

    IsGrouped = (Not grp Is Nothing)
End Function

【讨论】：

谢谢！现在这是有道理的，上面的代码是一个很好的包罗万象的方法，可以防止在不知道分组项存在的情况下丢失分组项。

【解决方案2】：

所以经过一番摆弄，我偶然发现了上述问题的答案。问题是我对剩余的复选框进行了分组，无论出于何种原因，这都阻止了它们在上述代码的循环中被拾取。我取消了它们的分组，突然代码就可以工作了。我不确定为什么 VBA/Excel 会这样做，但如果有人能解释一下，我想知道原因。

谢谢。

【讨论】：