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

Question

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

     Sub InsertCrossRef()
        'thank you stackoverflow:                
       /sf/ask/3329152151/
       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

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

Answer 1

1.以这种方式使您的主子程序参数化：

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

2.接下来，InsertCrossRef您需要在里面识别和更改所有应该指向Word Object( 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