使用 VBA 循环遍历 Powerpoint 中用户窗体中的复选框

Question

当用户在 PPT 幻灯片上运行 GUI 时，它会弹出一个用户表单，如下图所示。

他们可以 select 在复选框中最多选择 3 个危险。我试图找到一种方法来遍历所有复选框以查看哪些是 selected（如果 none，那么它只会退出 sub）。然后，根据select编辑了哪一个，它会在PPT幻灯片中的形状中输入相应的图像。形状从左到右排列。 "highest ranking" select 离子会在左边的形状中，三个中的 "lowest ranking" 会在右边的盒子里。如果只有两个选项 selected，则只会填充第一个和第二个形状。我不确定为每个选项的重要性顺序分配值（即 1、2、3 等）的最简单方法。我宁愿不必用 If -> Then 语句涵盖所有组合，因为那样会很乏味且非常耗时。我认为有更好的方法来做到这一点？

我可以使用以下代码轻松循环组合框列表：

Private Sub MainImage()
Call Dictionary.MainImageDict

'References the Dictionary for the Main Image options.

ComboBoxList = Array(CStr(ComboBox2)) 'ComboBox2 is the Main Image dropdown.

    For Each Ky In ComboBoxList
    On Error Resume Next
    'If nothing is selected in the Main Image dropdown, do nothing and exit this sub.
    If Ky = "" Then
    Exit Sub
    'Otherwise, if anything is selected in the Main Image dropdown, insert image and remove placeholder text.
    ElseIf Ky <> "" Then
    ActiveWindow.Selection.SlideRange.Shapes("MainImage").Fill.UserPicture (dict3.Item(Ky)(0))

    End If

    Next

Set dict3 = Nothing

End Sub

上面引用的词典如下：

Public dict, dict2, dict3, dict4, dict5 As Object, Key, val 'Makes the dictionaries public so they can be accessed by other Modules.

Sub MainImageDict()

'This is the dictionary for the Main Image portion of the slides.

Set dict3 = CreateObject("Scripting.Dictionary")

Key = "Day 1 High Temperatures": val = Array("URL_to_Image")
dict3.Add Key, val
Key = "Day 2 High Temperatures": val = Array("URL_to_Image")
dict3.Add Key, val

End Sub

如果可能的话，我想用复选框做类似的事情。由于它们都是独立的，而不是组合成一个（如组合框），我不确定如何去做。任何帮助将不胜感激！如果我说的任何内容没有意义，请告诉我。谢谢！

更新代码

使用建议的代码效果很好。现在我有最后一个问题。我已将代码修改为以下内容：

    Private Sub Hazards()
    Call Dictionary.HazardsDict

   'References the Dictionary for the Hazard Image options.

    Dim chkboxes As Variant
    Dim iCtrl As Long

    Select Case CountSelectedCheckBoxes(chkboxes)
        Case Is > 3
            MsgBox "Too many selected checkboxes!" & vbCrLf & vbCrLf & "please select three checkboxes only!", vbCritical
        Case Is = 1 'If only one checkbox is selected
            For iCtrl = LBound(chkboxes) To UBound(chkboxes)
              HazardList = Array(chkboxes(iCtrl).Caption)
              Debug.Print chkboxes(iCtrl).Caption
              Next
                'MsgBox chkboxes(iCtrl).Tag '<--| here you output each selected checkbox Tag. you can use this "number"
            For Each Ky In HazardList
                ActiveWindow.Selection.SlideRange.Shapes("Hazard1").Fill.UserPicture (dict5.Item(Ky)(0))
                ActiveWindow.Selection.SlideRange.Shapes("Hazard1Text").TextFrame.TextRange.Text = dict5.Item(Ky)(1)
            Next
        Case Is = 2 'If exactly 2 checkboxes are selected
            For iCtrl = LBound(chkboxes) To UBound(chkboxes)
              HazardList = Array(chkboxes(iCtrl).Caption)
              Debug.Print chkboxes(iCtrl).Caption
            Next
            For Each Ky In HazardList
                ActiveWindow.Selection.SlideRange.Shapes("Hazard1").Fill.UserPicture (dict5.Item(Ky)(0)) 'The checkbox with the lowest number in its Tag would go here.
                ActiveWindow.Selection.SlideRange.Shapes("Hazard1Text").TextFrame.TextRange.Text = dict5.Item(Ky)(1)
                ActiveWindow.Selection.SlideRange.Shapes("Hazard2").Fill.UserPicture (dict5.Item(Ky)(0)) 'The checkbox with the second lowest tag number would go here
                ActiveWindow.Selection.SlideRange.Shapes("Hazard2Text").TextFrame.TextRange.Text = dict5.Item(Ky)(1)
            Next
    End Select

    Set dict5 = Nothing

End Sub

我想弄清楚如何编写代码，以便其标签中编号最小的复选框进入 "Hazard1"，编号第二小的标签（最多 3 个）可以 selected) 进入 Hazard2，编号第三小的标签进入 Hazard3。有任何想法吗？谢谢！

Answer 1

您可以遍历 UserForm Controls 集合并检查那些 "CheckBox" TypeName

虽然您可以在复选框控件的 Tag 属性中存储一些 "importance rating"（在 VBA IDE 中按 F4 弹出属性 window、select 用户表单中的每个复选框并在 Tag 条目中键入正确的 "importance rating"）

以上所有你都可以利用如下：

Private Sub InsertBtn_Click()
    Dim chkboxes As Variant
    Dim iCtrl As Long

    Select Case CountSelectedCheckBoxes(chkboxes)
        Case Is > 3
            MsgBox "Too many selected checkboxes!" & vbCrLf & vbCrLf & "please select three checkboxes only!", vbCritical
        Case Is < 3
            MsgBox "Too few selected checkboxes!" & vbCrLf & vbCrLf & "please select three checkboxes!", vbCritical            
        Case Else
            For iCtrl = LBound(chkboxes) To UBound(chkboxes)
                MsgBox chkboxes(iCtrl).Tag '<--| here you output each selected checkbox Tag. you can use this "number"
            Next
    End Select
End Sub

Function CountSelectedCheckBoxes(chkboxes As Variant) As Long
    Dim ctrl As Control
    ReDim chkboxes(1 To Me.Controls.count)

    For Each ctrl In Me.Controls '<--| loop through userform controls
        If TypeName(ctrl) = "CheckBox" Then '<--| check if current control is a "checkbox" one
            If ctrl Then '<--| check if it's "checked"
                CountSelectedCheckBoxes = CountSelectedCheckBoxes + 1 '<--| update checked checkboxes counter
                Set chkboxes(CountSelectedCheckBoxes) = ctrl '<--| store it in the array
            End If
        End If
    Next
    If CountSelectedCheckBoxes > 0 Then ReDim Preserve chkboxes(1 To CountSelectedCheckBoxes) '<--|size checkboxes array to actual checked checkboxes found
End Function

使用 VBA 循环遍历 Powerpoint 中用户窗体中的复选框

Loop Through CheckBoxes in Userform in Powerpoint with VBA

powerpoint

vba