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