Formatting a Word Content Control

This VBA macro pair will validate and reformat the text.

I suggest that you use the Word Option/Customize facility to set the  macro to be called from a QAT button or a keystroke shortcut.

Sub ValidateCC()
    Dim strText As String
    Dim strParts(3) As String
    Dim bFail As Boolean
    Dim cc As ContentControl
    
    Set cc = Selection.Range.ContentControls(1)
    
    strText = Replace(cc.Range.Text, "-", "") 'remove any existing hyphens
    If Len(strText) <> 14 Then
        bFail = True
        Exit Sub
    End If
    strText = UCase(strText)
    
    strParts(0) = Mid(strText, 1, 4)
    strParts(1) = Mid(strText, 5, 3)
    strParts(2) = Mid(strText, 8, 3)
    strParts(3) = Mid(strText, 11, 4)
    
    If Not IsNumeric(strParts(0)) Then
        bFail = True
    End If
    If Not IsNumeric(strParts(1)) Then
        bFail = True
    End If
    If Not IsAlpha(strParts(2)) Then
        bFail = True
    End If
    If Not IsNumeric(strParts(3)) Then
        bFail = True
    End If
        
    If bFail = True Then
        MsgBox "Invalid format"
        Exit Sub
    Else
        cc.Range.Text = Join(strParts, "-")
    End If
End Sub

Function IsAlpha(strTestString As String) As Boolean
    Dim i As Integer
    
    For i = 1 To Len(strTestString)
        Select Case Mid(strTestString, i, 1)
            Case "a" To "z", "A" To "Z"
            Case Else
                Exit Function
        End Select
    Next i
    IsAlpha = True
End Function

Select allOpen in new window

Hi,

You could test it at the Exit of the contentcontrol

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    If ContentControl.Tag = "Reference" Then
        Dim strPattern As String: strPattern = "(\d{4})-?(\d{3})-?([A-Z]{3})-?(\d{4})"
        Dim strReplace As String: strReplace = "$1-$2-$3-$4"
        Set RE = CreateObject("vbscript.regexp")
        With RE
            .IgnoreCase = IgnoreCase
            .Pattern = strPattern
        End With

        If RE.Test(ContentControl.Range.Text) Then
            ContentControl.Range.Text = UCase(RE.Replace(ContentControl.Range.Text, strReplace))
        Else
            MsgBox ("Format of reference is not right")
            Cancel = True
        End If
    End If
End Sub

Select allOpen in new window

Regards

GrahamSkan: I wrote your code as shown, I just get an error, "The requested member of the collection does not exist."

Rgonzo1971: I wrote your code as shown, Word will not even find it.

Which line gives the error, please?

Ignore that. For reasons now forgotten I pulled the code out of the Exit event (as Rgonzo is using)
This was my original code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    Dim strText As String
    Dim strParts(3) As String
    Dim bFail As Boolean
    
    If ContentControl.Tag = "MyFormat" Then
        strText = Replace(ContentControl.Range.Text, "-", "") 'remove any existing hyphens
        If Len(strText) <> 14 Then
            bFail = True
            Exit Sub
        End If
        strText = UCase(strText)
        
        strParts(0) = Mid(strText, 1, 4)
        strParts(1) = Mid(strText, 5, 3)
        strParts(2) = Mid(strText, 8, 3)
        strParts(3) = Mid(strText, 11, 4)
        
        If Not IsNumeric(strParts(0)) Then
            bFail = True
        End If
        If Not IsNumeric(strParts(1)) Then
            bFail = True
        End If
        If Not IsAlpha(strParts(2)) Then
            bFail = True
        End If
        If Not IsNumeric(strParts(3)) Then
            bFail = True
        End If
            
        If bFail = True Then
            MsgBox "Invalid format"
            Exit Sub
        Else
            ContentControl.Range.Text = Join(strParts, "-")
        End If
    End If
End Sub

Select allOpen in new window

I am trying to run it from "On Exit" from the text form field.

Note that the procedure will run when any content control is exited, so there is a need to flag relevant controls. In the example, such controls need to have the tag set to "MyFormat".

There is no Tags on "Text Form Fields", only "Bookmarks"

Running from a text formfield explains why there is no content control in the selection.

I think we are at cross purposes. A Content Control and a Text Form Field are completely different objects.

Thank you

Is there a way to enhance this code?
I have tried the following but it locks up with no result.

Sub ValidateFunctionLocation()
 
Dim strText As String
Dim strParts(3) As String
Dim bFail As Boolean
Dim ffld As FormField
 
If Len(strText) = 13 Then
    MsgBox "Using 2 Letter Equipment Type"
    ValidateFunctionLocation13
ElseIf Len(strText) = 14 Then
    MsgBox "Using 3 Letter Equipment Type"
    ValidateFunctionLocation14
Else:
    bFail = True
    MsgBox "Invalid 'Function Location' Format.", vbInformation
    Exit Sub
End If
 
End Sub
 
Sub ValidateFunctionLocation14()
 
'Function Location in this format ####-###-XXX-####
 
Dim strText As String
Dim strParts(3) As String
Dim bFail As Boolean
Dim ffld As FormField
 
Set ffld = ActiveDocument.FormFields("txtFunctionLocation")
strText = Replace(ffld.Result, "-", "")
 
If Len(strText) <> 14 Then
    bFail = True
End If
 
strText = UCase(strText)
 
strParts(0) = Mid(strText, 1, 4)
strParts(1) = Mid(strText, 5, 3)
strParts(2) = Mid(strText, 8, 3)
strParts(3) = Mid(strText, 11, 4)
 
If Not IsNumeric(strParts(0)) Then
    bFail = True
End If
 
If Not IsNumeric(strParts(1)) Then
    bFail = True
End If
 
If Not IsAlpha(strParts(2)) Then
    bFail = True
End If
 
If Not IsNumeric(strParts(3)) Then
    bFail = True
End If
 
ffld.Result = Join(strParts, "-")
 
End Sub
 
Sub ValidateFunctionLocation13()
 
'Function Location in this format ####-###-XX-####
 
Dim strText As String
Dim strParts(3) As String
Dim bFail As Boolean
Dim ffld As FormField
 
Set ffld = ActiveDocument.FormFields("txtFunctionLocation")
strText = Replace(ffld.Result, "-", "")
 
If Len(strText) <> 13 Then
    bFail = True
End If
 
strText = UCase(strText)
 
strParts(0) = Mid(strText, 1, 4)
strParts(1) = Mid(strText, 5, 3)
strParts(2) = Mid(strText, 8, 2)
strParts(3) = Mid(strText, 10, 4)
 
If Not IsNumeric(strParts(0)) Then
    bFail = True
End If
 
If Not IsNumeric(strParts(1)) Then
    bFail = True
End If
 
If Not IsAlpha(strParts(2)) Then
    bFail = True
End If
 
If Not IsNumeric(strParts(3)) Then
    bFail = True
End If
 
ffld.Result = Join(strParts, "-")
 
End Sub
 
 
Function IsAlpha(strTestString As String) As Boolean
 
Dim i As Integer
 
For i = 1 To Len(strTestString)
    Select Case Mid(strTestString, i, 1)
        Case "a" To "z", "A" To "Z"
        Case Else
            Exit Function
        End Select
Next i
 
IsAlpha = True
   
End Function
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
 
Dim cc As ContentControl
 
For Each cc In ContentControls
    If Left(ContentControl.Tag, 8) = Left(cc.Tag, 8) Then
        If cc.Tag <> ContentControl.Tag Then
            cc.Checked = False
        End If
    End If
Next
 
End Sub