从动态用户窗体VBA中提取数据

您需要创建变量来保存对新创建的CommandButtons的引用。通过添加 WithEvents 修改器您将能够接收CommandButton事件。

以单元格值命名控件是有问题的。更好的解决方案是使用MSForms控件标记属性来保存引用。在下面的示例中,我向目标单元格添加了一个限定引用。

• 将子例程名称从addLabel更改为更有意义的Show\u UserForm6。

• 添加时的组合框值。

Option Explicit
Public WithEvents CommandApp As MSForms.CommandButton
Public WithEvents CommandCan As MSForms.CommandButton

Private Sub CommandApp_Click()
    Dim ctrl As MSForms.Control

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ComboBox" Then
            Range(ctrl.Tag).Value = ctrl.Value
        End If
    Next

End Sub

Private Sub CommandCan_Click()
    Unload Me
End Sub

重构代码

Sub Show_UserForm6()
    Const PaddingTop = 34, Left1 = 10, Left2 = 90, Left3 = 190
    Dim c As Range
    Dim Top As Single
    Top = 34
    With UserForm6
        .Show vbModeless
        For Each c In Sheets("Sheet1").Range("A1:A100")
            If c.Value = "" Then Exit For

            With getNewControl(.Controls, "Forms.Label.1", Left1, 50, 20, Top)
                .Caption = c.Value
                .Tag = "'" & c.Parent.Name & "'!" & c.Address
            End With

            With getNewControl(.Controls, "Forms.Label.1", Left2, 50, 20, Top)
                .Caption = c.Offset(0, 1).Value
                .Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
            End With

            With getNewControl(.Controls, "Forms.ComboBox.1", Left3, 120, 20, Top)
                .List = Array("Approved", "Partially Approved", "Not Approved")
                .Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
                .Value = c.Offset(0, 2).Value
            End With

            Top = Top + 20
        Next

        Set .CommandApp = getNewControl(.Controls, "Forms.Commandbutton.1", 10, 140, 20, Top + 10)

        With .CommandApp
            .Caption = "Submit"
        End With

        Set .CommandCan = getNewControl(.Controls, "Forms.Commandbutton.1", 170, 140, 20, Top + 10)

        With .CommandCan
            .Caption = "Cancel"
        End With
    End With
End Sub

Function getNewControl(Controls As MSForms.Controls, ProgID As String, Left As Single, Width As Single, Height As Single, Top As Single) As MSForms.Control
    Dim ctrl As MSForms.Control
    Set ctrl = Controls.Add(ProgID)
    With ctrl
        .Left = Left
        .Width = Width
        .Font.Size = 10
        .Top = Top
    End With
    Set getNewControl = ctrl
End Function

通常,我会设置类和集合来保存对新控件的引用。

不过,它可以与当前设置配合使用。首先,我建议进行美学上的改变:

• 将框架的大小设置为适合屏幕的静态大小,并在此之外添加两个命令按钮。
• 调整框架大小,使其位于形状的边界内。
• 更改 ScrollBars 属性到 2 - fmScrollBarsVertical .

在您的代码中:
添加新变量

Dim fme As Frame  
Set fme = UserForm6.Frame1

更新您对的引用 UserForm6 所以他们引用 fme 相反,当您添加标签和组合框时:

Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)  
.
.
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True) 
.
.
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)

在最终循环之外,添加这行代码(您可能需要通过数学运算获得正确的滚动高度):

fme.ScrollHeight = buttonheight + 90  

删除添加两个命令按钮的代码(因为它们现在在帧外是静态的)。

现在,您的整个表单应该位于页面上,您可以滚动控件。

双击命令按钮以添加 Click 事件:

Private Sub CommandButton1_Click()
    Dim ctrl As Control
    Dim x As Long

    For Each ctrl In Me.Frame1.Controls
        If TypeName(ctrl) = "ComboBox" Then
            x = x + 1
            ThisWorkbook.Worksheets("Sheet2").Cells(x, 1) = ctrl.Value
        End If
    Next ctrl
End Sub

代码将遍历表单上的每个组合框,并将所选值复制到工作簿中的Sheet2。

编辑:

所有包含我所做更改的代码。

Sub addLabel()
    UserForm6.Show vbModeless
    Dim theLabel As Object
    Dim ComboBox1 As Object
    Dim CommandApp As Object
    Dim CommandCan As Object
    Dim buttonheight As Long

    Dim fme As Frame

    Dim c As Variant

    Dim labelCounter As Long

    Set fme = UserForm6.Frame1

    For Each c In Sheets("Sheet1").Range("A1:A100")
    If c.Value = "" Then Exit For
        Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
        With theLabel
        .Caption = c
        .Left = 10
        .Width = 50
        .Height = 20
        .Font.Size = 10
        If c.Row = 1 Then
        .Top = 34
        Else
        .Top = 25 + (20 * (c.Row - 1)) + 9
        End If
        End With

      Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)

     With ComboBox1
        .AddItem "Approved"
        .AddItem "Partially Approved"
        .AddItem "Not Approved"
        .Left = 190
        .Width = 120
        .Height = 20
        .Font.Size = 10
        If c.Row = 1 Then
        .Top = 30
        Else
        .Top = 30 + (20 * (c.Row - 1))
        buttonheight = 30 + (20 * (c.Row - 1))
        End If
    End With
    Next c

    For Each c In Sheets("Sheet1").Range("B1:B100")
     If c.Value = "" Then Exit For
       Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
        With theLabel
        .Caption = c
        .Left = 90
        .Width = 70
        .Height = 20
        .Font.Size = 10
         If c.Row = 1 Then
        .Top = 34
         Else
        .Top = 25 + (20 * (c.Row - 1)) + 9
         End If
        End With
    Next c

    fme.ScrollHeight = buttonheight + 90

End Sub