在Word-File中的每个单词上运行VBA宏

我根据自己的需要改编了这个other answer . 我的更改通过填充的数组查看，并将所选文本与Header文本而不是Header编号以及其他一些小的更改进行匹配 .

Sub InsertCrossRef()
        'thank you stackoverflow:                
       https://stackoverflow.com/questions/47559316/macro-to-insert-a-cross-
       reference-based-on-selection
            Dim RefList As Variant 'list of all available headings and 
            numbered items available
            Dim LookUp As String 'string to be lookedup
            Dim Ref As String 'reference string in which there is to be searched
            Dim s As Integer, t As Integer 'calculated variabels for the string changes
            Dim i As Integer 'looping integer

            On Error GoTo ErrExit
            With Selection.Range


                ' discard leading blank spaces
                Do While (Asc(.Text) = 32) And (.End > .Start)
                    .MoveStart wdCharacter
                Loop
                ' discard trailing blank spaces, full stops, etc
                Do While ((Asc(Right(.Text, 1)) = 46) Or _
                          (Asc(Right(.Text, 1)) = 32) Or _
                          (Asc(Right(.Text, 1)) = 11) Or _
                          (Asc(Right(.Text, 1)) = 13)) And _
                          (.End > .Start)
                    .MoveEnd wdCharacter, -1
                Loop

        ' error protection

           ErrExit:
                If Len(.Text) = 0 Then
                    MsgBox "Please select a reference.", _
                           vbExclamation, "Invalid selection"
                    Exit Sub
                End If

                LookUp = .Text

            End With
            On Error GoTo 0

            With ActiveDocument
                ' Use WdRefTypeHeading to retrieve Headings
                RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
                For i = UBound(RefList) To 1 Step -1
                    Ref = Trim(RefList(i))

                    If InStr(1, Ref, LookUp, vbTextCompare) = 13 Or InStr(1,                                   Ref, LookUp, vbTextCompare) = 12 Then
                        s = InStr(2, Ref, " ") 'set S = xValue when position 2 returns a Space
                        t = InStr(2, Ref, Chr(9)) 'set T = 1 when position 2 returns a Tab
                        If (s = 0) Or (t = 0) Then
                            s = IIf(s > 0, s, t)
                        Else
                            s = IIf(s < t, s, t)
                        End If

                        If LookUp = Right(Ref, Len(Ref) - s) Then Exit For

                        'If LookUp = Left(Ref, s - 1) Then Exit For
                    End If
                Next i

        ' create the cross reference, add a space when acidently a space was selected
                If i Then

                If Right(Selection.Range, 1) = " " Then

                    Selection.InsertCrossReference ReferenceType:="Numbered item", _
                                                   ReferenceKind:=wdContentText, _
                                                   ReferenceItem:=CStr(i), _
                                                   InsertAsHyperlink:=True, _
                                                   IncludePosition:=False, _
                                                   SeparateNumbers:=False, _
                                                   SeparatorString:=" "
                    Selection.InsertAfter " "

                Else
                    Selection.InsertCrossReference ReferenceType:="Numbered item", _
                                                   ReferenceKind:=wdContentText, _
                                                   ReferenceItem:=CStr(i), _
                                                   InsertAsHyperlink:=True, _
                                                   IncludePosition:=False, _
                                                   SeparateNumbers:=False, _
                                                   SeparatorString:=" "
                End If


                Else
                    MsgBox "A cross reference to """ & LookUp & """ couldn't be set" & vbCr & _
                           "because a paragraph with that number couldn't" & vbCr & _
                           "be found in the document.", _
                           vbInformation, "Invalid cross reference"
                End If
            End With
        End Sub

我想要实现的是在我的文档中的每个单词上运行此代码：

For Each sentence In ActiveDocument.StoryRanges
   For Each w In sentence.Words

    'above code should run        

   Next

我所期望的是宏将遍历我的文档中的每个单词，看它是否匹配任何 Headers 并在上面应用交叉引用maacro .