从动态用户表单中提取数据 VBA

Question

所有，

我有下面的代码，它根据 excel 工作表中的列表创建动态用户窗体。（请看下图）

当用户选择提交时，我想将用户表单中的所有答案提取到一个 excel 文件中。

有谁知道我该怎么做，因为我的想法遇到了瓶颈，据我所知，用户表单必须通过 vba 构建，因为项目 ID 和 UR 的列表可能会有所不同1 行到数千行。

如有任何帮助，我们将不胜感激。

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 labelCounter As Long

For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
    Set theLabel = UserForm6.Controls.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 = UserForm6.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 = UserForm6.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

With UserForm6
.Width = 340
.Height = buttonheight + 90

End With

Set CommandApp = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandApp
    .Caption = "Submit"
    .Left = 10
    .Width = 140
    .Font.Size = 10
    .Top = buttonheight + 30
End With

Set CommandCan = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandCan
    .Caption = "Cancel"
    .Left = 170
    .Width = 140
    .Font.Size = 10
    .Top = buttonheight + 30
End With

End Sub

Answer 1

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

虽然它可以与您当前的设置一起使用。首先，我建议进行美学上的改变：

将框架的大小设置为适合屏幕的静态大小，并在此之外添加两个命令按钮。
调整框架的大小，使其位于表单的边界内。
将 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

Answer 2

您将需要创建变量来保存对新创建的命令按钮的引用。通过添加 WithEvents 修饰符，您将能够接收命令按钮事件。

在单元格值之后命名控件存在问题。更好的解决方案是使用 MSForms 控件标记属性来保存您的引用。在下面的示例中，我添加了对目标单元格的限定引用。

将子例程名称从 addLabel 更改为更有意义的名称 Show_UserForm6。
添加的组合框值。

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

从动态用户表单中提取数据 VBA

Extracting data from a dynamic userform VBA

excel

vba

userform

Userform6 模块

重构代码