PDA

View Full Version : Dynamic Userform



gmaxey
06-04-2013, 11:03 AM
I'm having trouble attempting to reuse a dynamic userform "name."

I basically have a requirement to building and destroy a dynamic userform multple times during a session in a document (e.g., I may need to display the form repeated and each time is may have a different number of controls). I've not even started with that part yet.

The trouble is, it seems that whenever I create a userform with code (tThis is the simple example from the MSDN site), using the code below, then I can't run the code a second time to create the same userform again. When I try, the code errors on the .Name = "frmDynamic" property with a RTE 75 Path\Access error.

Can anyone explain why?

Sub BuildMyForm()
Dim mynewform
Set mynewform = _
ActiveDocument.VBProject.VBComponents.Add(vbext_ct_MSForm)
With mynewform
.Properties("Height") = 246
.Properties("Width") = 616
.Name = "frmDynamic"
.Properties("Caption") = "This is a test"
End With
'Added by me.
Application.VBE.ActiveVBProject.VBComponents.Remove mynewform
Set mynewform = Nothing
End Sub

fumei
06-04-2013, 03:28 PM
I error out on

vbext_ct_MSForm

Variable not defined

I think I may know why, but can you post a link to the MSDN page first.

gmaxey
06-04-2013, 03:36 PM
Ah. Yes you need a references to the VBA Extensibility library:

http://support.microsoft.com/kb/204330

fumei
06-04-2013, 04:25 PM
that was totally dense and stupid of me....

If I step through (with Extensibility reference), I error out (75) on the Name instruction. Cannot find the specified object.

fumei
06-04-2013, 04:36 PM
Not only that but if I run:
With mynewform
.Properties("Height") = 246
.Properties("Width") = 616
' .Name = "frmDynamic"
.Properties("Caption") = "This is a test"
End With
Debug.Print mynewform.Height

even thought Height was just used (correctly as it changed the userform), the debug line errors out with 438.

Object does not support this property or method.

You know, there is something nagging at me here.

fumei
06-04-2013, 04:40 PM
Oh, I know.

.Name = "frmDynamic"


needs to be:
.Properties("Name") = "frmDynamic"


Ah, now I do not have errors.

fumei
06-04-2013, 04:50 PM
OK, if you DO comment out the name instruction it works fine. I can execute multiple iterations of the userform Sub - as many as I like - with no error.

fumei
06-04-2013, 04:55 PM
I think there is a hidden record of the userforms created, even though they are removed.

gmaxey
06-04-2013, 05:10 PM
Gerry,

I had tried that:

Sub BuildMyForm()
Dim mynewform
Set mynewform = _
ActiveDocument.VBProject.VBComponents.Add(vbext_ct_MSForm)
With mynewform
.Properties("Height") = 246
.Properties("Width") = 616
.Properties("Name") = "frmDynamic"
.Properties("Caption") = "This is a test"
End With
Application.VBE.ActiveVBProject.VBComponents.Remove mynewform
Set mynewform = Nothing
End Sub


Still no joy. I can create one, but running the code over again results in the error again :-(

gmaxey
06-04-2013, 05:12 PM
I wander how one clears that record? If I save and close the file then reopen I can create and kill one more but not a second.

fumei
06-04-2013, 05:15 PM
I have not got a clue. I have been trying to drill down and find it but it does not seem to be exposed. I keep banging up to either 13 or 438 errors.

Seems very odd, but it would not be the first time that MS kept things to themselves.

fumei
06-04-2013, 05:27 PM
Whoa, now THIS is weird. I created userforms (Userform1, Userform2).

Userform2...wait for it...has NO properties. I click on 1 and there is the Properties windows. I click on 2 - and it IS showing in the Project window - and the properties windows is utterly blank.

Now I have never - ever - seen that. Do you work at finding crap like this? I did a refresh and now the Properties shows. Well blow me down.

newbie101
06-05-2013, 04:58 AM
while I have no clue as to the explanation of this behavior, I think a possible workaround would be using a collection of forms, something like the following:
Dim ufColl As Collection

Sub GenerateForms()
Dim uf As frmDynamic
Dim i As Integer

Set ufColl = New Collection
For i = 1 To 5
Set uf = New frmDynamic
ufColl.Add uf, "frmDynamic" & x
Next i
End Sub

newbie101
06-05-2013, 05:01 AM
Just as an after-thought, would showing and unloading the form completely remove it from the memory?

gmaxey
06-05-2013, 07:15 AM
No joy. The only way I've found to use the same name over is to first close the document then reopen it.

Sub BuildMyForm()
Dim mynewform
Set mynewform = _
ActiveDocument.VBProject.VBComponents.Add(vbext_ct_MSForm)
With mynewform
.Properties("Height") = 246
.Properties("Width") = 616
.Properties("Name") = "frmDynamics"
.Properties("Caption") = "This is a test"
End With
'Application.VBE.ActiveVBProject.VBComponents.Remove mynewform
Set mynewform = Nothing
End Sub
Sub Test()
Dim oComp As VBComponent
frmDynamics.Show
Unload frmDynamics
For Each oComp In Application.VBE.ActiveVBProject.VBComponents
If oComp.Name = "frmDynamics" Then
Application.VBE.ActiveVBProject.VBComponents.Remove oComp
Exit For
End If
Next
'.Remove oComp
End Sub

fumei
06-05-2013, 04:59 PM
I really think it is a hidden sequential record. Similar to the counter for say formfields.

If you make a text formfield, the name is Text1, the second Text2, third Text3. The next will be Text4. If you delete Text1 and Text2 BEFORE you make the next one,the next one is STILL Text4.

Even though there are only two (the first two are removed, deleted), there is a record somewhere that there WAS the previous ones. That information is NOT in the collection of formfields...it is somewhere else. And it is not exposed to VBA.

There is a difference though (re: the formfields). If you removed all of them, the invisible counter resets to 0. As you are removing the userform ( counter = 0), you would think you could reuse the name again. But - shrug - apparently not.

gmaxey
06-05-2013, 06:26 PM
I thought I was making progress but alas :-(

I have figured out a way to ensure I can create multiple dynamic forms:

[vba]Sub BuildMyForm()
ActiveDocument.Variables("frmName").Value = "frmDyanmic"
Dim mynewform
Set mynewform = _
ActiveDocument.VBProject.VBComponents.Add(vbext_ct_MSForm)
With mynewform
.Properties("Height") = 246
.Properties("Width") = 616
On Error GoTo Err_Name
.Properties("Name") = ActiveDocument.Variables("frmName").Value
.Properties("Caption") = "This is a test"
End With
Set mynewform = Nothing
Exit Sub
Err_Name:
ActiveDocument.Variables("frmName").Value = ActiveDocument.Variables("frmName").Value & Replace(Format(Now, "mm:ss"), ":", "")
Resume
End Sub
[vba]

The problem now is I can't figure out now how to access and display the variably named userform:


Sub UseMyNewForm()
Dim oFrm 'As MSForms.UserForm
Dim oComp As VBComponent
For Each oComp In Application.VBE.ActiveVBProject.VBComponents
If oComp.Name = ActiveDocument.Variables("frmName").Value Then
Exit For
End If
Next
Set oFrm = oComp.Designer

oFrm.Show
For Each oComp In Application.VBE.ActiveVBProject.VBComponents
If oComp.Name = ActiveDocument.Variables("frmName").Value Then
Application.VBE.ActiveVBProject.VBComponents.Remove oComp
Exit For
End If
Next
End Sub

I can't figure out how to .Show the form.

gmaxey
06-06-2013, 12:40 PM
Finally got traction! Ok, I figured out how to ".Show" my dynamic form with code and add dynamic event procedures. As a practical (maybe not ideal) example, you can add a few simple bookmarks to a document:
e.g., Name, Age, Hair_Color, DOB, ect.

Copy the following code to a standard module. Then run BuildDynaicUserForm.

Thanks for all the support and interest shown in this thread. Comments and criticism welcome.



Sub BuildDynamicUserForm()
'NOTE: Set a reference to the VBA Extensibility library first!
Dim oUserForm As VBComponent, oChkBox As Object, oLabel As Object, oTextbox As Object, oCmdBtn As Object
Dim lngIndex As Long, lngTextboxes As Long
Dim oCM As VBIDE.CodeModule
Dim lngLine As Long
'Set intial dynamic form name.
ActiveDocument.Variables("frmName").Value = "frmDyanmic"
lngTextboxes = ActiveDocument.Bookmarks.Count
'Create the form.
Set oUserForm = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_MSForm)
With oUserForm
On Error GoTo Err_Name
'Form name can only be used to create one instance of the dynamic form per document session. (I don't know why)/
.Name = ActiveDocument.Variables("frmName").Value
On Error GoTo 0
.Properties("Caption") = "Bookmarks"
End With
'Add decriptive label.
Set oLabel = oUserForm.Designer.Controls.Add("Forms.Label.1")
With oLabel
.Top = 9
.Left = 9
.Height = 18
.Width = 140
.Name = "lbl_Title"
.Font.Name = "Tahoma"
.Font.Size = 11
.Caption = "Document Bookmark Values:"
End With
'Add and position textboxes. One per document bookmark.
For lngIndex = 1 To lngTextboxes
Set oTextbox = oUserForm.Designer.Controls.Add("Forms.TextBox.1")
With oTextbox
.Top = 35 + 24 * (lngIndex - 1)
.Left = 102
.Height = 21
.Width = 180
.Name = "TextBox" & lngIndex
.Font.Name = "Tahoma"
.Font.Size = 11
End With
Next lngIndex
'Add and position labels. One per document bookmark.
For lngIndex = 1 To lngTextboxes
Set oLabel = oUserForm.Designer.Controls.Add("Forms.Label.1")
With oLabel
.Top = 35 + 24 * (lngIndex - 1)
.Left = 12
.Height = 21
.Width = 80
.Name = "Label" & lngIndex
.TextAlign = 3
.Caption = Replace(ActiveDocument.Bookmarks(lngIndex).Name, "_", " ") & ":"
.Font.Name = "Tahoma"
.Font.Size = 11
End With
Next lngIndex
'Add and position command button.
Set oCmdBtn = oUserForm.Designer.Controls.Add("Forms.CommandButton.1")
With oCmdBtn
.Top = oTextbox.Top + 28
.Left = 12
.Width = 272
.Height = 21
.Name = "cmd_OK"
.Caption = "OK"
End With
'Adjust form's height so it's appropriate to the # of boxes.
oUserForm.Properties("Height") = 70 + 24 * (lngTextboxes + 1)
oUserForm.Properties("Width") = 300
'Add form event procedures. To simplify, I've just added calls to hard coded procedures in a standard project module.
Set oCM = oUserForm.CodeModule
With oCM
lngLine = oUserForm.CodeModule.CreateEventProc("Initialize", "UserForm")
lngLine = lngLine + 1
.InsertLines lngLine, " Main.FrmInitialize Me "
End With
With oCM
lngLine = oUserForm.CodeModule.CreateEventProc("Click", "cmd_OK")
lngLine = lngLine + 1
.InsertLines lngLine, " Main.ClickEvent Me"
lngLine = lngLine + 1
.InsertLines lngLine, " Hide"
End With
Set oUserForm = Nothing
Set oLabel = Nothing
Set oChkBox = Nothing
Set oTextbox = Nothing
'Call and show the form.
OpenAndUseDynamicForm
Exit Sub
Err_Name:
'Create new unique name.
ActiveDocument.Variables("frmName").Value = ActiveDocument.Variables("frmName").Value & Replace(Format(Now, "hh:mm:ss"), ":", "")
Resume
End Sub
Sub OpenAndUseDynamicForm()
Dim oComp As VBComponent
Dim oFrm As Object 'Don't know why I can't use as UserForm??

For Each oComp In Application.VBE.ActiveVBProject.VBComponents
If oComp.Type = vbext_ct_MSForm Then
If oComp.Name = ActiveDocument.Variables("frmName").Value Then
Set oFrm = VBA.UserForms.Add(oComp.Name)
Exit For
End If
End If
Next oComp
oFrm.Show
Unload oFrm
Set oFrm = Nothing
Application.VBE.ActiveVBProject.VBComponents.Remove oComp
lbl_Exit:
Exit Sub
End Sub
Sub ClickEvent(ByRef oFrm As Object)
Dim lngIndex As Long
Dim strName As String
Dim oRng As Word.Range
For lngIndex = 1 To ActiveDocument.Bookmarks.Count
strName = ActiveDocument.Bookmarks(lngIndex).Name
Set oRng = ActiveDocument.Bookmarks(lngIndex).Range
oRng.Text = oFrm.Controls("Textbox" & lngIndex).Value
ActiveDocument.Bookmarks.Add strName, oRng
Next lngIndex
lbl_Exit:
Exit Sub
End Sub
Sub FrmInitialize(ByRef oFrm As Object)
Dim lngIndex As Long
For lngIndex = 1 To ActiveDocument.Bookmarks.Count
oFrm.Controls("Textbox" & lngIndex).Value = ActiveDocument.Bookmarks(lngIndex).Range.Text
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

nachumk
05-13-2017, 08:44 AM
This was so amazingly useful! Thank you!
I also discovered that I can dynamically add and remove forms without a name crash if I avoid naming the form, and just record the automatic name given. And if you happen to always name it "UserForm1" you're also OK. Weird Word bug...
Nachum

gmaxey
05-13-2017, 09:22 AM
Thanks for the comment. I had forgotten about this and should update it for use with content controls.

gmaxey
05-15-2017, 05:43 PM
For Content Controls since they do not require unique titles or tags this dynamic code will create a userform control for any CC tagged "Master"

It does not handle the situation were you have two or more like titled CCs tagged as "Master" Avoiding that is up to you:


Option Explicit
Sub BuildDynamicUserForm()
'NOTE: Set a reference to the VBA Extensibility library first!
Dim oUF As VBComponent
Dim oLabel As Object, oCtrl As Object, oCtrlLast As Object, oCmdBtn As Object
Dim oCM As VBIDE.CodeModule
Dim oCC As ContentControl
Dim lngLine As Long
'Set intial dynamic form name.
ActiveDocument.Variables("frmName").Value = "frmDyanmic"
'Create the form.
Set oUF = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_MSForm)
With oUF
On Error GoTo Err_Name
'Form name can only be used to create one instance of the dynamic form per document session. (I don't know why)
.Name = ActiveDocument.Variables("frmName").Value
On Error GoTo 0
.Properties("Caption") = "Content Controls"
End With
'Add decriptive label.
Set oLabel = oUF.Designer.Controls.Add("Forms.Label.1")
With oLabel
.Top = 9
.Left = 9
.Height = 18
.Width = 200
.Name = "lbl_Title"
.Font.Name = "Tahoma"
.Font.Size = 11
.Caption = "Document Content Control Values:"
End With
'Add and position controls. One per document content control.
Set oCtrlLast = oLabel
For Each oCC In ActiveDocument.ContentControls
'Since CC titles, unlike bookmark name, do not have to be unique, process only CCs tagged "Master"
If oCC.Tag = "Master" Then
Select Case oCC.Type
Case 0, 1, 6
Set oCtrl = oUF.Designer.Controls.Add("Forms.TextBox.1")
oCtrl.Name = "txt" & Replace(oCC.Title, " ", "_")
Case 3
Set oCtrl = oUF.Designer.Controls.Add("Forms.ComboBox.1")
oCtrl.Name = "cbo" & Replace(oCC.Title, " ", "_")
Case 4
Set oCtrl = oUF.Designer.Controls.Add("Forms.ListBox.1")
oCtrl.Name = "lst" & Replace(oCC.Title, " ", "_")
Case 8
Set oCtrl = oUF.Designer.Controls.Add("Forms.CheckBox.1")
oCtrl.Name = "chk" & Replace(oCC.Title, " ", "_")
End Select
With oCtrl
.Top = oCtrlLast.Top + oCtrlLast.Height + 3 '35 + 24 * (lngTopIndex - 1)
.Left = 122
If TypeName(oCtrl) = "ListBox" Then
.Height = 42
Else
.Height = 21
End If
.Tag = oCC.ID
.Width = 180
.Font.Name = "Tahoma"
.Font.Size = 11
End With
Set oLabel = oUF.Designer.Controls.Add("Forms.Label.1")
With oLabel
.Top = oCtrl.Top
.Left = 12
.Height = 21
.Width = 100
.Name = "lbl" & Replace(oCC.Title, " ", "_")
.TextAlign = 3
.Caption = oCC.Title
.Font.Name = "Tahoma"
.Font.Size = 11
End With
Set oCtrlLast = oCtrl
End If
Next oCC
'Add and position command button.
Set oCmdBtn = oUF.Designer.Controls.Add("Forms.CommandButton.1")
With oCmdBtn
.Top = oCtrlLast.Top + oCtrlLast.Height + 4
.Left = 12
.Width = 290
.Height = 21
.Name = "cmd_OK"
.Caption = "OK"
End With
'Adjust form's height so it's appropriate to the # of boxes.
oUF.Properties("Height") = 45 + oCmdBtn.Top
oUF.Properties("Width") = 320
'Add form event procedures. To simplify, I've just added calls to hard coded procedures in a standard project module.
Set oCM = oUF.CodeModule
With oCM
lngLine = oUF.CodeModule.CreateEventProc("Initialize", "UserForm")
lngLine = lngLine + 1
.InsertLines lngLine, " Main.FrmInitialize Me "
End With
With oCM
lngLine = oUF.CodeModule.CreateEventProc("Click", "cmd_OK")
lngLine = lngLine + 1
.InsertLines lngLine, " Main.ClickEvent Me"
lngLine = lngLine + 1
.InsertLines lngLine, " Hide"
End With
Set oUF = Nothing
Set oLabel = Nothing: Set oCtrl = Nothing: Set oCtrlLast = Nothing
'Call and show the form.
OpenAndUseDynamicForm
Exit Sub
Err_Name:
'Create new unique name.
ActiveDocument.Variables("frmName").Value = ActiveDocument.Variables("frmName").Value & Replace(Format(Now, "hh:mm:ss"), ":", "")
Resume
End Sub
Sub OpenAndUseDynamicForm()
Dim oComp As VBComponent
Dim oFrm As Object 'Don't know why I can't use as UserForm??
For Each oComp In Application.VBE.ActiveVBProject.VBComponents
If oComp.Type = vbext_ct_MSForm Then
If oComp.Name = ActiveDocument.Variables("frmName").Value Then
Set oFrm = VBA.UserForms.Add(oComp.Name)
Exit For
End If
End If
Next oComp
oFrm.Show
Unload oFrm
Set oFrm = Nothing
Application.VBE.ActiveVBProject.VBComponents.Remove oComp
lbl_Exit:
Exit Sub
End Sub
Sub ClickEvent(ByRef oFrm As Object)
Dim lngIndex As Long
Dim strName As String
Dim oRng As Word.Range
Dim oCtrl As Control
Dim oCC As ContentControl
For Each oCtrl In oFrm.Controls
Select Case TypeName(oCtrl)
Case "TextBox", "ComboBox"
Set oCC = ActiveDocument.ContentControls(oCtrl.Tag)
oCC.Range.Text = oCtrl.Text
Case "ListBox"
Set oCC = ActiveDocument.ContentControls(oCtrl.Tag)
With oCC
.Type = wdContentControlText
.Range.Text = oCtrl.Text
.Type = wdContentControlDropdownList
End With
Case "CheckBox"
Set oCC = ActiveDocument.ContentControls(oCtrl.Tag)
oCC.Checked = oCtrl.Value
End Select
Next oCtrl
lbl_Exit:
Exit Sub
End Sub
Sub FrmInitialize(ByRef oFrm As Object)
Dim oCC As ContentControl
Dim oCtrl As Control
Dim lngDDE As Long
For Each oCC In ActiveDocument.ContentControls
If oCC.Tag = "Master" Then
Select Case oCC.Type
Case 0, 1, 6 'Rich text, plain text and date CCs
Set oCtrl = oFrm.Controls("txt" & Replace(oCC.Title, " ", "_"))
If Not oCC.ShowingPlaceholderText Then
oCtrl.Value = oCC.Range.Text
End If
Case 3 'Combobox
Set oCtrl = oFrm.Controls("cbo" & Replace(oCC.Title, " ", "_"))
For lngDDE = 2 To oCC.DropdownListEntries.Count
With oCtrl
.AddItem oCC.DropdownListEntries(lngDDE).Text
End With
Next
If Not oCC.ShowingPlaceholderText Then
oCtrl.Value = oCC.Range.Text
End If
Case 4 'Dropdown list
Set oCtrl = oFrm.Controls("lst" & Replace(oCC.Title, " ", "_"))
For lngDDE = 2 To oCC.DropdownListEntries.Count
With oCtrl
.AddItem oCC.DropdownListEntries(lngDDE).Text
If oCC.Range.Text = oCC.DropdownListEntries(lngDDE).Text Then
.ListIndex = lngDDE - 2
End If
End With
Next
Case 8 'Checkbox
Set oCtrl = oFrm.Controls("chk" & Replace(oCC.Title, " ", "_"))
oCtrl.Value = oCC.Checked
End Select
End If
Next oCC
lbl_Exit:
Exit Sub
End Sub