VBA UserForm：在运行时添加TextBox或CommandButton和事件

Question

我很乐意为您提供帮助！我一直在寻找整个网络，但我卡住了！

我一直在编程VBA一段时间，但我仍然努力了解这种语言！

我想在MS Project 2007 VBA中创建一个VBA UserForm。 一些数据是动态的，所以我需要在运行时添加一些文本字段。

我把一些代码放在一起来添加这些，它工作得很好。

我的问题是添加事件到这些文本字段。

我的例子是txtPath文本字段。 我使用此代码创建它：

Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1") 
    With NewTextBox 
     .name = "txtPath" 
     .value = "Test" 
     .top = m2w_style("top") + (m2w_style("height") * 1) 
     .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") 
     .Width = m2w_style("txtWidth") 
     .height = m2w_style("height") 
     .font.Size = m2w_style("fontsize") 
     .font.name = m2w_style("font") 
    End With 

而且我希望有一个反应，如果txtPath的价值发生了变化。 下面的代码：

私人小组txtPath_Change（）“事件投篮不中 readProjectsFromConfig（Me.value） 结束小组

所有我浏览和搜索表明，它应该以这种方式工作网站，但事件只是不拍摄。

我发现动态创建的文本字段不会像手动创建的文本框一样显示在“本地窗口”树中的相同位置。

所以我试过这至少得到了文本字段的值，它的工作原理。

Private Sub btnPath_Click() 
    'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm 
    'Controls.Item("txtPath").value = "Hello World!" ' This works! 
    Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath 
End Sub 

下面是测试的全码：

' Reference to Library 
' Microsoft XML, v5.0 need to be activated. 
' Go to menu: Tools->References 
' Select Microsoft Scripting Runtime 

Public m2w_config As Dictionary 
Public m2w_style As Dictionary 


Sub m2wVariables() 
    ' Set global Variables for configuration in a kind of hash. 
    Set m2w_config = New Dictionary 
    Set m2w_style = New Dictionary 

    'Styles for teh UserForm 
    m2w_style("font") = "Arial" 
    m2w_style("fontsize") = 10 
    m2w_style("top") = 6 
    m2w_style("left") = 6 
    m2w_style("height") = 20 
    m2w_style("btnHeight") = 8 
    m2w_style("width") = 40 
    m2w_style("lblWidth") = 40 
    m2w_style("h1Width") = 400 
    m2w_style("txtWidth") = 180 
    m2w_style("btnWidth") = 72 
    m2w_style("margin") = 6 

    m2w_config("XMLDateFormat") = "YYYY-MM-DD" 
    m2w_config("XMLConfigFileName") = "config.xml" ' should not be changeable 
    m2w_config("AppPath") = "" 
    m2w_config("Headline") = "" ' Headline in Website 
    m2w_config("UpdateHref") = "" 
    m2w_config("SubFolder") = "" ' Is it used? 
    m2w_config("default_subfolder") = "" ' Is it used? 

End Sub 

    Private Sub UserForm_Activate() 

     Dim LabelArr As Variant 
     Dim ProbNameArr As Variant 
     Dim TempForm As Object 
     Dim NewButton As MSForms.CommandButton 
     Dim NewLabel As MSForms.Label 
     Dim NewTextBox As MSForms.TextBox 
     Dim e As Variant 
     Dim x As Integer 
     Dim page As String 
     'Dim Line As Integer 
     'Dim MyScript(4) As String 

     m2wVariables 


     ' Setup userform 
     '~~~~~~~~~~~~~~~~ 

     'This is to stop screen flashing while creating form 
     Application.VBE.MainWindow.Visible = False 

     ' Setup tab Website 
     '=================== 
      page = "Website" 
      Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1") 
      With NewLabel 
       .name = "lblHeadlinePath" 
       .Caption = "This is the local path where the website shall be stored." 
       .top = m2w_style("top") + (m2w_style("height") * 0) 
       .Left = m2w_style("left") 
       .Width = m2w_style("h1Width") 
       .height = m2w_style("height") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
      End With 

      Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1") 
      With NewLabel 
       .name = "lblPath" 
       .Caption = "Path:" 
       .top = m2w_style("top") + (m2w_style("height") * 1) 
       .Left = m2w_style("left") 
       .Width = m2w_style("lblWidth") 
       .height = m2w_style("height") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
      End With 

      Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1") 
      With NewTextBox 
       .name = "txtPath" 
       .value = "Test" 
       .top = m2w_style("top") + (m2w_style("height") * 1) 
       .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") 
       .Width = m2w_style("txtWidth") 
       .height = m2w_style("height") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
      End With 

      'Add event onClick 
      ' This is completely weird, it actualy writes code. 
      ' My intention is to add an event at runtime. 
      With ThisProject.VBProject.VBComponents("msp2web_SettingsForm").CodeModule 
      .insertlines .CountOfLines + 1, "Sub txtPath_Change()" & vbCrLf & "MsgBox Me.txtPath.Value" & vbCrLf & "End Sub" 
      Debug.Print Now & " This macro has code lines " & .CountOfLines 
      End With 


      Dim btnName As String 
      btnName = "btnPath" 
      'Set NewButton = Me.InfoMultiPage(page).Controls.Add("Forms.commandbutton.1", btnName) ' Add dynamicly - but I'm too stupid to add an event action to an dynamicly created button... 
      Set NewButton = Me.InfoMultiPage(page).Controls.Item(btnName) 
      With NewButton 
       .Caption = "Browse..." 
       .top = m2w_style("top") + (m2w_style("height") * 1) 
       .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") + m2w_style("txtWidth") + m2w_style("margin") 
       .Width = m2w_style("lblWidth") 
       .height = m2w_style("btnHeight") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
       .AutoSize = True 
      End With 


     ' Setup Tab Project 
     '=================== 
     page = "Project" 
     LabelArr = Array("Hallo", "Welt", "Model Year") 
     ProbNameArr = Array("Hallo", "Welt", "Model Year") 

     'Create 10 Labels just for testing - works fine 
     'For x = 0 To 9 
     x = 0 
     For Each e In LabelArr 
      Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1") 
      With NewLabel 
       .name = "FieldLabel" & x + 1 
       .Caption = e 
       .top = m2w_style("top") + (m2w_style("height") * x) 
       .Left = m2w_style("left") 
       .Width = m2w_style("lblWidth") 
       .height = m2w_style("height") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
      End With 
      x = x + 1 
     Next 

     'Create 10 Text Boxes 
     'For x = 0 To 9 
     x = 0 
     For Each e In ProbNameArr 
      Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1") 
      With NewTextBox 
       .name = "MyTextBox" & x + 1 
       .top = m2w_style("top") + (m2w_style("height") * x) 
       .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") 
       .Width = m2w_style("lblWidth") 
       .height = m2w_style("height") 
       .font.Size = m2w_style("fontsize") 
       .font.name = m2w_style("font") 
      End With 
      x = x + 1 
     Next 

    End Sub 

    Private Sub btnPath_Click() 
     'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm 
     'Controls.Item("txtPath").value = "Hello World!" ' This works! 
     Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath 
    End Sub 

    Private Sub txtPath_Change() ' Event doesn't shoot 
     readProjectsFromConfig (Me.value) 
    End Sub 


    Private Sub Refresh_Click() 
     readProjectsFromConfig (Controls.Item("txtPath").value) 
    End Sub 

冷谁能告诉我如何创建代码（运行时）基于文本框和命令按钮并添加事件呢？

非常感谢！

Answer 1

查看Gary的回答to a similar question。你可以使用一个类来声明它和WithEvents。

您只能获得共享的事件处理程序，但可以根据调用控件切换操作。

添

Answer 2

当我想动态添加一个用户窗体控件我只是去添加控件，我创建类似于发现here一个WITHEVENTS类的路线。