The other day I posted looking for a way to automatically detect and correct grammar subj-verb agreement errors. The reason was that I have been tinkering with XMLMapping and using content controls to display various personal pronouns.

For anyone interested, a compact version of my efforts is provided here (Note - all of the code goes in the ThisDocument Module):

Option Explicit
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Enum GotFocusHow
  TabKey = 1
  ShiftTabKeys = 4
  LeftMouseBtn = 3
  AltKey = 2
End Enum
Public p_oCCMonitored As ContentControl
Sub AddGenderXMLPartMapPicker()
Dim oXMLPart As CustomXMLPart
Dim oCC As ContentControl
Dim arrPronouns() As String
Dim oRng As Range
Dim oNode As CustomXMLNode
  On Error Resume Next
  Set oXMLPart = ActiveDocument.CustomXMLParts.SelectByNamespace("http://GenderXML/Basic.com").Item(1)
  If Err.Number = 0 Then
    oXMLPart.Delete
  End If
  Set oXMLPart = ActiveDocument.CustomXMLParts.Add("<?xml version='1.0'?><GenderXML xmlns='http://GenderXML/Basic.com'>" _
                                                & "<genderNode xmlns='' " _
                                                & "subjPronounFirstCap='' " _
                                                & "subjPronoun='' " _
                                                & "objPronoun='' " _
                                                & "possessiveDeterminerPronounFirstCap='' " _
                                                & "possessiveDeterminerPronoun='' " _
                                                & "possessivePronoun='' " _
                                                & "reflexivePronoun='' " _
                                                & "PronounSetPerson='' >" _
                                                & "</genderNode></GenderXML>")
   With ActiveDocument
     Set oRng = Selection.Range
     oRng.Text = String(10, vbCr)
     Set oCC = .ContentControls.Add(wdContentControlCheckBox, oRng.Paragraphs(1))
     With oCC
       .SetCheckedSymbol CharacterNumber:=&H2642, Font:="Times New Roman"
       .SetUncheckedSymbol CharacterNumber:=&H2640, Font:="Times New Roman"
       .Title = "Check Gender"
       .XMLMapping.SetMapping oXMLPart.DocumentElement.ChildNodes(1).XPath
       If .Checked Then
         arrPronouns = fcnPronouns("Third Person Masculine")
       Else
         arrPronouns = fcnPronouns("Third Person Feminine")
       End If
     End With
     oRng.Paragraphs(2).Range.Text = "Relocate, delete or copy/paste the following mapped CCs as required."
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@subjPronounFirstCap")
     oNode.Text = arrPronouns(0)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(3).Range)
     With oCC
       .Title = "Subject (He/She)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@subjPronoun")
     oNode.Text = arrPronouns(1)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(4).Range)
     With oCC
       .Title = "subject (he/she)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@objPronoun")
     oNode.Text = arrPronouns(2)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(5).Range)
     With oCC
       .Title = "object (him/her)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessiveDeterminerPronounFirstCap")
     oNode.Text = arrPronouns(3)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(6).Range)
     With oCC
       .Title = "Determiner (His/Her)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessiveDeterminerPronoun")
     oNode.Text = arrPronouns(4)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(7).Range)
     With oCC
       .Title = "determiner (his/her)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessivePronoun")
     oNode.Text = arrPronouns(5)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(8).Range)
     With oCC
       .Title = "possessive (his/hers)"
       .XMLMapping.SetMapping oNode.XPath
     End With
     Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@reflexivePronoun")
     oNode.Text = arrPronouns(6)
     Set oCC = .ContentControls.Add(wdContentControlText, oRng.Paragraphs(9).Range)
     With oCC
       .Title = "reflexive (himself/herself)"
       .XMLMapping.SetMapping oNode.XPath
     End With
  End With
  oRng.InsertBefore "Click to set/toggle gender: "
lbl_Exit:
  Set oXMLPart = Nothing
  Exit Sub
End Sub
Private Sub Document_ContentControlOnEnter(ByVal oCC_Entered As ContentControl)
Dim bTabEntry As Boolean
  
  If oCC_Entered.Title = "Check Gender" And oCC_Entered.Type = 8 Then
    'A click entry (via mouse) in a checkbox CC triggers an automatic state change a tab entry from another CC does not.
    'How was CC entered?
    bTabEntry = fcn_CCTabEntry
    If Not bTabEntry Then
      'The user clicked the control and it changed state on enter.  Pass the CC to the custom change event.
      CC_OnChange oCC_Entered
    End If
    'Set the public CC variable to the CC entered.  This is the CC targeted for monitoring.
    Set p_oCCMonitored = oCC_Entered
    'Call the "new" ContentControlMonitor asynchrounously.  This allows this procedure to run to termination.
    Application.OnTime Now + TimeSerial(0, 0, 0.01), "ContentControlMonitor"
  End If
End Sub
Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
'A built-in document event.  Fires when a CC is exited.
  Set p_oCCMonitored = Nothing
End Sub
Public Function CC_OnChange(oCC_InEvent As ContentControl)
  Select Case oCC_InEvent.Title
    Case "Check Gender"
      #If VBA7 Then
        If oCC_InEvent.Type = 8 Then
          If oCC_InEvent.Checked = True Then
            SetAttributes "Third Person Masculine"
          Else
            SetAttributes "Third Person Feminine"
          End If
        End If
     #End If
   Case Else
     'Do nothing.
   End Select
  Application.ScreenRefresh
lbl_Exit:
  Exit Function
End Function
Public Sub ContentControlMonitor()
'Intiated via CC OnEnter events, this procedure continously monitors the CC range for a content change.
'Triggers the "new" OnChange event when a change occurs.
Dim strCC_Text As String
Dim bCC_State As Boolean
  'A successful OnExit event will terminate the reference to the monitored CC and raise an error.
  On Error GoTo Err_Handler
  'Set the intial text or state to compare.
  strCC_Text = p_oCCMonitored.Range.Text
  Do While strCC_Text = p_oCCMonitored.Range.Text
    DoEvents
    'Detect changes.
    If strCC_Text <> p_oCCMonitored.Range.Text Then
      'Pass the CC_Changed
      CC_OnChange p_oCCMonitored
      'Set new text to compare
      strCC_Text = p_oCCMonitored.Range.Text
    End If
  Loop
Err_ReEntry:
  Exit Sub
  'Handle expected error 91
Err_Handler:
  'Debug.Print Err.Number & " " & Err.Description & ". An exit event has terminated the reference to the monitored CC."
  Resume Err_ReEntry
End Sub
Private Function fcn_CCTabEntry() As Boolean
'Determine how content control focus was achieved, and set the appropriate flag
Dim lngRet As GotFocusHow
  If GetKeyState(vbKeyTab) < 0 Then
    If (GetKeyState(vbKeyShift) < 0) Then
      'Shift-Tab key is pressed
      lngRet = ShiftTabKeys
    Else
      'Tab key is pressed
      lngRet = TabKey
    End If
  ElseIf GetKeyState(vbKeyMenu) < 0 Then
    'Alt key is pressed (hotkey activation)
    lngRet = AltKey
  ElseIf GetKeyState(vbKeyLButton) < 0 Then
    'Mouse left button is pressed
    lngRet = LeftMouseBtn
  End If
  'Set the flag here
  Select Case lngRet
    Case TabKey, ShiftTabKeys
      fcn_CCTabEntry = True
    Case Else
      fcn_CCTabEntry = False
  End Select
End Function

Sub SetAttributes(strType As String)
Dim oXMLPart As CustomXMLPart
Dim oNode As CustomXMLNode
Dim arrPronouns() As String
  arrPronouns = fcnPronouns(strType)
  Set oXMLPart = ActiveDocument.CustomXMLParts.SelectByNamespace("http://GenderXML/Basic.com").Item(1)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@subjPronounFirstCap")
  oNode.Text = arrPronouns(0)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@subjPronoun")
  oNode.Text = arrPronouns(1)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@objPronoun")
  oNode.Text = arrPronouns(2)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessiveDeterminerPronounFirstCap")
  oNode.Text = arrPronouns(3)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessiveDeterminerPronoun")
  oNode.Text = arrPronouns(4)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@possessivePronoun")
  oNode.Text = arrPronouns(5)
  Set oNode = oXMLPart.SelectSingleNode("/ns0:GenderXML[1]/genderNode[1]/@reflexivePronoun")
  oNode.Text = arrPronouns(6)
  Set oXMLPart = Nothing
  Set oNode = Nothing
lbl_Exit:
  Exit Sub
End Sub
Function fcnPronouns(strPerson As String) As String()
  Select Case strPerson
    Case "Third Person Masculine"
      fcnPronouns = Split("He|he|him|His|his|his|himself", "|")
    Case "Third Person Feminine"
      fcnPronouns = Split("She|she|her|Her|her|hers|herself", "|")
  End Select
lbl_Exit:
  Exit Function
End Function