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

时间:2016-09-14 10:26:52

标签: excel vba excel-vba

所以我有一个表单上有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则

我收到编译错误: 找不到方法或数据成员

1 个答案:

答案 0 :(得分:0)

管理得到这个工作,感谢关于通过控件循环的提示!

这是按钮上的代码,它可以正常工作......

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
相关问题