（VBA）如何从动态创建的复选框中检索选定的复选框数据

Question

所以我有一个上面有 2 个按钮的表单，代码从数据表中捕获列标题，添加到数组中，然后创建复选框，根据列标题重命名标题。然后它会检查此信息是否先前已保存在报告表上并预先选择复选框。

这一切都在下面的代码中工作，我无法解决的是当我按下按钮“OKButn”以使其从这些动态创建的复选框中获取数据选择数据并将其添加到数组中以便我可以输出结果到 报告表。

此按钮的代码保存在表单代码表中 - 只有这样我才能使按钮正常工作（据我所知）。动态创建按钮也很好 - 我可以这样做，但是在被点击后让它们运行代码，我无法解决。

到目前为止，这是我的代码：

Option Explicit

Public HdrArray(), HdrColArray()
Public z, y, TotalHdrs, SavedHdrsCol, SavedHdrsRow, TotalSavedHdrs As Integer
Public AddOption As Object


Sub PopulateForm()

ColumnCopyForm.Show vbModeless
ColumnCopyForm.Caption = "Column Copy Selection """

Sheets("Data").Select

'Find total number of headers
TotalHdrs = Sheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column

'Find cell that records the 'required columns'
SavedHdrsCol = Sheets("Report").Range("A1:zz100").Find("Required Columns", LookIn:=xlValues).Column
SavedHdrsRow = Sheets("Report").Range("A1:zz100").Find("Required Columns", LookIn:=xlValues).Row

'Count total rows
TotalSavedHdrs = Sheets("Report").Cells(Sheets("Data").Rows.Count, SavedHdrsCol).End(xlUp).Row

For z = 0 To (TotalHdrs - 1)
    'If Sheets("Data").Cells(1, 1 + z).Value = "Item Type" Then
    'Delete Columns on Data Sheet
    'Sheets("Data").Columns(z).EntireColumn.Delete
    'Else

    'Makes the array dynamic
    ReDim Preserve HdrArray(TotalHdrs, z)

    'Adds the Data table header label to the array (column 0)
    HdrArray(0, z) = Sheets("Data").Cells(1, 1 + z).Value

    'Adds the column number to the array (Column 1)
    HdrArray(1, z) = z

    'Adds a check box - renaming it to the column title
    Set AddOption = ColumnCopyForm.Controls.Add("Forms.CheckBox.1", "LabelOpt" & z, True)
    With AddOption
        .Caption = HdrArray(0, z)
        .Left = 10
        .Width = 200
        .Top = .Height * z

        'Automatically selects this if the option has been previously saved to copy to report sheet
        For y = 0 To (TotalSavedHdrs - 1)
            If Sheets("Report").Cells(SavedHdrsRow + 1 + y, SavedHdrsCol).Value = HdrArray(0, z) Then
                AddOption.Value = True

                'Add info to Array
                HdrArray(2, z) = 1
            End If
        Next y
    End With
    'End If

    'Make button visible - and format
    ColumnCopyForm.OKButn.Visible = True
    With ColumnCopyForm.OKButn
        .Caption = "Apply & Close"
        .Top = ColumnCopyForm.Height - 50
        .Left = ColumnCopyForm.Width - 130
        .Width = 70
        .Height = 20
        .ZOrder (0)
    End With

    'Make button visible - and format
    ColumnCopyForm.CancelButn.Visible = True
    With ColumnCopyForm.CancelButn
        .Caption = "Cancel"
        .Top = ColumnCopyForm.Height - 50
        .Left = ColumnCopyForm.Width - 50
        .Width = 40
        .Height = 20
        .ZOrder (0)
    End With

Next z

End Sub

这是按钮的代码...

Option Explicit

Sub OKButn_Click()

For y = 0 To (TotalHdrs - 1)
    MsgBox (HdrArray(0, y) & " - " & HdrArray(2, y))

    'Saves the preferences to the report sheet
    If HdrArray(2, y) = "1" Then
        Sheets("Report").Cells(SavedHdrsRow + 1 + y, SavedHdrsCol).Value = HdrArray(0, y)
    End If
Next y

Unload ColumnCopyForm

End Sub

这是我认为可以在按钮下工作的代码...

Sub OKButn_Click()

    For y = 0 To (TotalHdrs - 1)
    Set LabelOptName = "LabelOpt" & (y + 1)

    If ColumnCopyForm.LabelOptName.Value = True Then
        HdrArray(2, y) = 1
    End If


    MsgBox (HdrArray(0, y) & " - " & HdrArray(2, y))
        'Saves the preferences to the report sheet
        If HdrArray(2, y) = "1" Then
            Sheets("Report").Cells(SavedHdrsRow + 1 + y, SavedHdrsCol).Value = HdrArray(0, y)

        End If

    Next y

Unload ColumnCopyForm
End Sub

但是在这一行：

如果 ColumnCopyForm.LabelOptName.Value = True 那么

我得到一个编译错误： 找不到方法或数据成员

Answer 1

设法让这个工作，感谢有关循环通过控件的提示！

这里是按钮上的代码确实有效...

Sub OKButn_Click()
z = 0
y = 0
'Loops through the controls on the form, to get values of the Checkboxes
   For Each ctlLoop In ColumnCopyForm.Controls
'Checks to see if the value is true so it can be recorded
   If ctlLoop.Value = True Then
   'Records the column title in the correct place for future referencing
      Sheets("Report").Cells(SavedHdrsRow + 1 + y, SavedHdrsCol).Value = HdrArray(0, z)
      y = y + 1

    End If
    z = z + 1
    Next ctlLoop


Unload ColumnCopyForm
End Sub