vba - 将项目添加到在运行时添加到用户窗体的 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

删除“设计师”一词

试试这个(经过尝试和测试)

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

屏幕截图

更多跟进

Thanks for the solution , In case if I have to call addComboBox more than once, i.e to add two or more combo boxes , UserForm_Initialize sub will be created more than once, which is problem again. – Vikram

在这种情况下，您必须检查UserForm_Initialize过程是否存在，然后解析它。请参阅下面的代码。我在您的函数中添加了一个新的可选参数 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

屏幕截图(用户表单)

屏幕截图(用户表单代码)