HTSCF Fareha
03-27-2021, 07:15 AM
I have the following to fill out a number of Content Control form fields on a document. Some of them work as intended, whilst others fill in their alloted ones but bleed into others, or they just don't work at all.
I've been scratching my head for hours now without any movement forward. :banghead:
(The Content Controls do exist and are labelled correctly)
'Person' is filling its own CCs (Person, Person,1, Person2), but is also populating 'Officer'.
'RMSNum' won't play at all.
'PostCode' is ignoring the uppercase command.
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 = "txtPostCode" Then
strTC = strConv(oCtrl.Text, vbUpperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("PostCode1").Item(1)
oCC.Range.Text = strTC
ActiveDocument.SelectContentControlsByTag("PostCode2").Item(1).Range.Text = oCC.Range.Text
ElseIf oCtrl.Name = "txtRMSNum" Then
Set oCC = ActiveDocument.SelectContentControlsByTag("RMSNum").Item(1)
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 = strTC
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
Any help will be very much appreciated!
Steve
I've been scratching my head for hours now without any movement forward. :banghead:
(The Content Controls do exist and are labelled correctly)
'Person' is filling its own CCs (Person, Person,1, Person2), but is also populating 'Officer'.
'RMSNum' won't play at all.
'PostCode' is ignoring the uppercase command.
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 = "txtPostCode" Then
strTC = strConv(oCtrl.Text, vbUpperCase)
Set oCC = ActiveDocument.SelectContentControlsByTag("PostCode1").Item(1)
oCC.Range.Text = strTC
ActiveDocument.SelectContentControlsByTag("PostCode2").Item(1).Range.Text = oCC.Range.Text
ElseIf oCtrl.Name = "txtRMSNum" Then
Set oCC = ActiveDocument.SelectContentControlsByTag("RMSNum").Item(1)
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 = strTC
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
Any help will be very much appreciated!
Steve