VBA 用户窗体：在运行时添加文本框或命令按钮和事件

VBA UserForm: Add TextBox or CommandButton and event during runtime

提问by BBQ Chef

I'd be glad to get some help! I've been searching the whole net but I'm stuck!

我很乐意得到一些帮助！我一直在搜索整个网络，但我被卡住了！

I've been programming VBA for a while but I'm still struggling to understand this language!

我已经编写 VBA 一段时间了，但我仍然在努力理解这种语言！

I want to create a VBA UserForm in MS Project 2007 VBA. A few data are dynamic and so I need to add a few text fields during runtime.

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

I put some code together to add these and it works quite fine.

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

My problem is to add events to these text fields.

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

My example is the txtPath text field. I create it with this code:

我的示例是 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

And I want a reaction if the value of txtPath has changed. Here the code:

如果 txtPath 的值发生变化，我想要一个反应。这里的代码：

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

Private Sub txtPath_Change() ' 事件不会触发 readProjectsFromConfig (Me.value) End Sub

All websites I've browsed and searched show that it should work this way, but the event just doesn't shoot.

我浏览和搜索过的所有网站都表明它应该以这种方式工作，但该事件并没有发生。

I found out that the dynamic created text field are not displayed at the same place in the tree of the “local window” like the manually created text boxes.

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

So I tried this to at least get the value of the text field and it works.

所以我尝试这样做至少可以获取文本字段的值并且它有效。

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

Here's the full code for testing:

这是用于测试的完整代码：

' 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

Cold anyone tell me how to create code based (during runtime) text boxes and command buttons and add events to them?

冷酷的人告诉我如何创建基于代码的（在运行时）文本框和命令按钮并向它们添加事件？

回答by Tim Williams

See Gary's answer to a similar questionon SO. You can do it using a class and declaring it WithEvents.

请参阅 Gary对 SO 上类似问题的回答。你可以使用一个类并用WithEvents声明它。

You only get a shared event handler, but you can switch actions based on the calling control.

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

Tim

蒂姆

回答by Jon49

When I want to dynamically add controls on a userform I just go the route of adding the controls to a withevents class that I created similar to what is found here.

当我想在用户窗体上动态添加控件时，我只需将控件添加到我创建的 withevents 类中，该类类似于此处找到的内容。