0
我很樂意爲您提供幫助！我一直在尋找整個網絡，但我卡住了！VBA UserForm：在運行時添加TextBox或CommandButton和事件
我一直在編程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
冷誰能告訴我如何創建代碼（運行時）基於文本框和命令按鈕並添加事件呢？
非常感謝！
您可能想看看您是否可以手動創建文本框，然後將其隱藏直至需要。我沒有試過這樣做，但它比動態的一切都容易得多。 – 2011-03-30 23:25:44