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

发布于 2024-10-28 10:45:24 字数 8116 浏览 8 评论 0原文

我很高兴得到一些帮助!我已经搜索了整个网络,但我被困住了!

我已经编写 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() ' 事件不触发 从配置中读取项目(Me.value) 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

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

' 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

有人告诉我如何创建基于代码的(在运行时)文本框和命令按钮并向它们添加事件吗?

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!

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.

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:

  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:

Private Sub txtPath_Change() ' Event doesn't shoot
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?

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

策马西风 2024-11-04 10:45:24

请参阅 Gary 对 SO 的类似问题的回答。您可以使用类并声明为 WithEvents 来完成此操作。

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

蒂姆

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

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

Tim

成熟稳重的好男人 2024-11-04 10:45:24

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

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.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文