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

Question

我很乐意得到一些帮助！我一直在寻找整个网但我被卡住了！

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

我想在MS Project 2007 VBA中创建VBA用户窗体。 一些数据是动态的，因此我需要在运行时添加一些文本字段。

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

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

我的例子是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的值发生了变化，我想要一个反应。 代码如下：

Private Sub 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关于SO的回答to a similar question。您可以使用类并将其声明为WithEvents。

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

添

Answer 2

当我想在userform上动态添加控件时，我只是将控件添加到我创建的类似于找到here的withevents类的路径。