Content Controls not working as expected

[HTSCF Fareha]

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

[gmaxey]

Have you stepped through your code line by line using the F8 key to see if the appropriate lines are being executed. It sounds like you might have some mapping to an XML part that is out of whack. If Officer is mapped to the Person node of the XMLPart and Officer is filled before Person then when person runs, Officer will be overwritten.

[HTSCF Fareha]

Stepping through the code produces a 'Run Time Error 91' Object Variable or With block variable not set here:


For Each oCtrl In .Controls

I'm afraid the rest of your explanation has gone clean over my head!

Anyway, I've gone through the template and rechecked the Content Controls using Graham's add in. Still no difference I'm afraid.

[gmaxey]

Send the file to me. Send website feedback and I will reply with my email address. If you can't send the file then perhaps a GoTo meeting and screen share.

Best Regards,
Greg Maxey


Rather be the wolf, hungry but free,
than the fat dog on the chain.
~from Aesop's fable.

[HTSCF Fareha]

Hi Greg

Thank you.

I've emailed my document to you.

Steve

[HTSCF Fareha]

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

[gmaxey]

Glad I could help.