将项添加到在运行时添加到userform的ComboBox

Question

我正在尝试将一个组合框添加到将在运行时创建的用户表单，我面临的问题是将项目添加到组合框？无法弄清楚错误的位置。感谢。

    Function addComboBox(ByRef TempForm As Object, ByVal controlType As String, 
ByVal pos As Integer, ByVal strCaption As String, ByVal strValues As String)

     Dim NewComboBox As MSforms.ComboBox
     Dim arr As Variant
     Dim i As Integer

     Set NewComboBox = TempForm.Designer.Controls.Add("forms.ComboBox.1")
      arr = Split(strValues, ";")


        With NewComboBox
                .Name = strCaption & "_" & controlType & "_" & pos
                .Top = 20 + (12 * pos)
                .Left = 100
                .Width = 150
                .Height = 12

        End With



      For i = 0 To UBound(arr)

       NewComboBox.AddItem arr(i)

      Next i

    End Function

Answer 1

删除Designer

这个词

尝试此操作（经过测试和测试）

Set NewComboBox = TempForm.Controls.Add("Forms.ComboBox.1")

<强>后续

试试这个。 （已审判并已经过测试）

Option Explicit

Sub Sample()
    Dim TempForm As Object
    Dim Ret

    Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    Ret = addComboBox(TempForm, "CBox", 1, "MyCombo", "1;2;3;4")

    VBA.UserForms.Add(TempForm.Name).Show
End Sub

Function addComboBox(ByRef TempForm As Object, ByVal controlType As String, _
ByVal pos As Integer, ByVal strCaption As String, ByVal strValues As String)

    Dim NewComboBox As MSForms.ComboBox
    Dim n As Long, nLines As Long, i As Long
    Dim arr As Variant

    Set NewComboBox = TempForm.designer.Controls.Add("Forms.ComboBox.1")
    arr = Split(strValues, ";")


    With NewComboBox
        .Name = strCaption & "_" & controlType & "_" & pos
        .Top = 20 + (12 * pos)
        .Left = 10
        .Width = 150
        .Height = 12
    End With

    n = 2

    With TempForm
        nLines = .CodeModule.CountOfLines
        .CodeModule.InsertLines nLines + 1, "Private Sub UserForm_Initialize()"
        For i = 0 To UBound(arr)
            .CodeModule.InsertLines nLines + n, "    " & _
            NewComboBox.Name & ".AddItem " & arr(i)
            n = n + 1
        Next i
        .CodeModule.InsertLines nLines + n, "End Sub"
    End With
End Function

<强> SCREENSHOT

更多关注

  

感谢您的解决方案，如果我不得不多次调用addComboBox，即添加两个或更多组合框，将不止一次创建UserForm_Initialize sub，这又是个问题。 - 维克拉姆

在这种情况下，您必须检查UserForm_Initialize proc是否存在，然后解析它。请参阅下面的代码。我在您的函数中添加了一个新的可选参数S。我正在使用它将组合放在另一个之下。

Option Explicit

Sub Sample()
    Dim TempForm As Object
    Dim Ret

    Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)

    Ret = addComboBox(TempForm, "CBox", 1, "MyCombo", "1;2;3;4")

    Ret = addComboBox(TempForm, "CBox1", 1, "MyCombo1", "5;6;7;8", 20)

    Ret = addComboBox(TempForm, "CBox2", 1, "MyCombo2", "9;10;11;12", 40)

    VBA.UserForms.Add(TempForm.Name).Show
End Sub

Function addComboBox(ByRef TempForm As Object, ByVal controlType As String, _
ByVal pos As Integer, ByVal strCaption As String, ByVal strValues As String, _
Optional s As Long)

    Dim NewComboBox As MSForms.ComboBox
    Dim n As Long, nLines As Long, i As Long, uInitLine As Long
    Dim arr As Variant
    Dim MyModule As Object

    Set NewComboBox = TempForm.Designer.Controls.Add("Forms.ComboBox.1")
    arr = Split(strValues, ";")

    With NewComboBox
        .Name = strCaption & "_" & controlType & "_" & pos
        .Top = 20 + (12 * pos) + s
        .Left = 10
        .Width = 150
        .Height = 12
    End With

    '~~> Connect to the code module of the Userform
    Set MyModule = ThisWorkbook.VBProject.VBComponents(TempForm.Name).CodeModule

    '~~> Check if there is a procedure called UserForm_Initialize
    On Error Resume Next
    uInitLine = MyModule.ProcStartLine("UserForm_Initialize", 0)
    On Error GoTo 0

    With TempForm
        '~~> UserForm_Initialize Found
        If uInitLine > 0 Then
            nLines = uInitLine + 2: n = 0
            For i = 0 To UBound(arr)
                .CodeModule.InsertLines nLines + n, "    " & _
                NewComboBox.Name & ".AddItem " & arr(i)
                n = n + 1
            Next i
        Else
            n = 2

            nLines = .CodeModule.CountOfLines

            .CodeModule.InsertLines nLines + 1, "Private Sub UserForm_Initialize()"
            For i = 0 To UBound(arr)
                .CodeModule.InsertLines nLines + n, "    " & _
                NewComboBox.Name & ".AddItem " & arr(i)
                n = n + 1
            Next i
            .CodeModule.InsertLines nLines + n, "End Sub"
        End If
    End With
End Function

SCREENSHOT（用户形式）

SCREENSHOT（用户形式代码）