VBA 用户窗体:在运行时添加文本框或命令按钮和事件
我很高兴得到一些帮助!我已经搜索了整个网络,但我被困住了!
我已经编写 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 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
请参阅 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
当我想在用户窗体上动态添加控件时,我只需将控件添加到我创建的 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.