My sincere thanks to Greg for his help and guidance.
Option Explicit
Private m_oFrm As frmNFAMalCom
Private Sub Document_New()
Set m_oFrm = New frmNFAMalCom
m_oFrm.Show
If m_oFrm.Tag = "Enter" Then FillForm
Unload m_oFrm
Set m_oFrm = Nothing
lbl_Exit:
Exit Sub
End Sub
Sub FillForm()
Dim oCtrl As Control
Dim oCC As ContentControl
Dim lngIndex As Long
Dim strTC As String
'*** Call CreatedDate procedure
CreatedDate
With m_oFrm
For Each oCtrl In .Controls
Select Case TypeName(oCtrl)
Case "TextBox"
If oCtrl.Name = "txtPerson" Then
strTC = strConv(oCtrl.Text, vbProperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("Person").Item(1)
oCC.Range.Text = strTC
ActiveDocument.SelectContentControlsByTag("Person1").Item(1).Range.Text = oCC.Range.Text
ActiveDocument.SelectContentControlsByTag("Person2").Item(1).Range.Text = oCC.Range.Text
ElseIf oCtrl.Name = "txtPersonAddr" Then
strTC = strConv(oCtrl.Text, vbProperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("PersonAddr").Item(1)
oCC.Range.Text = strTC
ElseIf oCtrl.Name = "txtPostCode1" Then
strTC = strConv(oCtrl.Text, vbUpperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("PostCode1").Item(1)
oCC.Range.Text = strTC
ElseIf oCtrl.Name = "txtPostCode2" Then
strTC = strConv(oCtrl.Text, vbUpperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("PostCode2").Item(1)
oCC.Range.Text = strTC
ElseIf oCtrl.Name = "txtRMSNum" Then
Set oCC = ActiveDocument.SelectContentControlsByTag("RMSNum").Item(1)
oCC.Range.Text = oCtrl.Text
ActiveDocument.SelectContentControlsByTag("RMSNum1").Item(1).Range.Text = oCC.Range.Text
ElseIf oCtrl.Name = "txtTarget" Then
strTC = strConv(oCtrl.Text, vbProperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("Target").Item(1)
oCC.Range.Text = strTC
ActiveDocument.SelectContentControlsByTag("Target1").Item(1).Range.Text = oCC.Range.Text
ElseIf oCtrl.Name = "txtTargetAddr" Then
strTC = strConv(oCtrl.Text, vbProperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("TargetAddr").Item(1)
oCC.Range.Text = strTC
' If explanation of NFA required, then add a paragraph
ElseIf oCtrl.Name = "txtExplanation" Then
Dim oRng As Range
Set oRng = ActiveDocument.SelectContentControlsByTag("Explanation").Item(1).Range
oRng.Collapse wdCollapseEnd
oRng.MoveStart wdCharacter, 1
oRng.InsertAfter vbCr
ActiveDocument.SelectContentControlsByTag("Explanation").Item(1).Range.Text = oCtrl.Text
ElseIf oCtrl.Name = "txtOfficer" Then
Set oCC = ActiveDocument.SelectContentControlsByTag("Officer").Item(1)
oCC.Range.Text = oCtrl.Text
ActiveDocument.SelectContentControlsByTag("Officer1").Item(1).Range.Text = oCC.Range.Text
Else
ActiveDocument.SelectContentControlsByTag(Replace(oCtrl.Name, "txt", "")).Item(1).Range.Text = oCtrl.Text
End If
Case "ComboBox"
ActiveDocument.SelectContentControlsByTag(Replace(oCtrl.Name, "cbo", "")).Item(1).Range.Text = oCtrl.Value
Case "OptionButton"
'Which one was selected
If oCtrl Then
'The one that returns true
ActiveDocument.SelectContentControlsByTag("Reason").Item(1).Range.Text = oCtrl.Caption
End If
End Select
Next oCtrl
End With
lbl_Exit:
Exit Sub
End Sub
Sub CreatedDate()
Dim oDate As Date
Dim oCC As ContentControl
oDate = ActiveDocument.BuiltInDocumentProperties("Creation Date")
Set oCC = ActiveDocument.SelectContentControlsByTag("Date").Item(1)
oCC.Range.Text = Format(oDate, "DDDD") & " " & Format(oDate, "D") & _
fcnOrdinal(Format(oDate, "D")) & " " & Format(oDate, "MMMM YYYY")
oCC.Range.NoProofing = True
ActiveDocument.SelectContentControlsByTag("Date1").Item(1).Range.Text = oCC.Range.Text
lbl_Exit:
Exit Sub
End Sub
Function fcnOrdinal(lngDay As Long) As String
'Adaptation from code used by macropod
Dim strOrd As String
If (lngDay Mod 100) < 11 Or (lngDay Mod 100) > 13 Then strOrd = _
Choose(lngDay Mod 10, ChrW(&H2E2) & ChrW(&H1D57), ChrW(&H207F) & ChrW(&H1D48), ChrW(&H2B3) & ChrW(&H1D48)) & ""
fcnOrdinal = IIf(strOrd = "", ChrW(&H1D57) & ChrW(&H2B0), strOrd)
lbl_Exit:
Exit Function
End Function