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?
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