Question

全部，

我有以下代码，它根据位于Excel工作表中的列表创建动态用户表单。（请参见下图）

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

有没有人知道我会如何做到这一点，因为我已经想到了一个砖墙，我知道的用户表格必须通过vba建立，作为Project ID＆amp; amp; 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

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

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

将子程序名称从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

2 个答案:

Userform6模块

重构代码