vba - 对 Word 文件中的每个单词运行 VBA 宏

Question

我已经改编了这个 other answer根据我的需要。我的更改查看填充的数组并将所选文本与标题文本而不是标题编号匹配，以及其他一些小更改。

     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

我所期望的是宏会遍历我文档中的每个单词，看看它是否与任何标题匹配并应用上面的交叉引用宏。

Answer 1

1.让你的主子程序以这种方式参数化:

Sub InsertCrossRef(rngWord as Range)
    ...
End Sub

2. 接下来，在 InsertCrossRef 中，您需要识别并更改应指向 Word 对象 的所有引用(rngWord)。给你的例子:

With Selection.Range '<< this should be changed into...
With rngWord '<<...this

我可以看到一个或多个其他人以这种方式改变。

3. 最后，以这种方式为每个单词调用它来完成您的循环:

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

      InsertCrossRef w

   Next
Next