Using Excel VBA, how to search for a specific word and insert comments against that word in a Word document?

问题

I am trying to create an excel based tool that reviews Word documents for specific errors. I want this tool to search for a word/sentence and insert a comment against it. I have written a code (please see below) that is able to highlight the word/sentence, however, unable to insert the comment.

Here is my code so far:

Sub Ref_Figs_Tbls()

    Dim wdDoc As Object

    Set wdDoc = ActiveDocument

    With wdDoc
        With .Range
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .MatchWildcards = True
                .Wrap = wdFindStop
                .Text = "Reference source not found"
                .Replacement.Text = ""
                .Execute
            End With

            Do While .Find.Found = True

                .Select
                .HighlightColorIndex = wdRed

                .Select
                Selection.Comments.Add Range:=Selection.Range
                Selection.TypeText Text:="Cross referencing error"

                .Collapse wdCollapseEnd
                .Find.Execute
            Loop
        End With
    End With

End Sub

回答1:

Since you say you're acting from within Excel Application, then an unqualified Selection object would reference the host application, i.e. it'd return the Excel Selection edited to add a Word host application code

Hence you have to explicitly qualify Word application object as the Parent of the wanted Selection object (which I can't see any trace of in your code, though...)

Sub Ref_Figs_Tbls()


    Dim WordApp As Object

    'try and get Word application object, or exit sub
    Set WordApp = GetObject(, "Word.Application")
    If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")
    If WordApp Is Nothing Then: MsgBox "Can't get a Word instance", vbCritical: Exit Sub

    With WordApp.ActiveDocument ' reference word application currently active document
        With .Range
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .MatchWildcards = True
                .Wrap = wdFindStop
                .text = "Reference source not found"
                .Replacement.text = ""
                .Execute
             End With

            Do While .Find.Found = True
                .Select
                With WordApp.Selection ' explicitly reference Word application object selection
                    .Range.HighlightColorIndex = wdRed
                    .Range.Comments.Add Range:=.Range '.Find.Parent
                    .text = "Cross referencing error"
                End With
                .Collapse wdCollapseEnd
                .Find.Execute
            Loop
        End With
    End With
    Set WordApp = Nothing
End Sub

---

BTW you don't need all that Select/Selection work, and you can directly work with wanted objects

for instance the Do While .Find.Found = True loop can turn into

        Do While .Find.Found = True
            With .Find ' reference the Find object
                .Parent.HighlightColorIndex = wdRed ' set Find Parent object (i.e. its Range) color
                .Parent.Comments.Add(Range:=.Parent).Range.text = "Cross referencing error" ' set Find Parent object (i.e. its Range) comment object text
                .Execute
            End With
        Loop

---

using Word as host application, the above code would simplify to:

Option Explicit

Sub Ref_Figs_Tbls()

    Dim wdDoc As Document

    Set wdDoc = ActiveDocument

    With wdDoc
        With .Range
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .MatchWildcards = True
                .Wrap = wdFindStop
                .Text = "Reference source not found"
                .Replacement.Text = ""
                .Execute
             End With

            Do While .Find.Found = True
                With .Find
                    .Parent.HighlightColorIndex = wdRed
                    .Parent.Comments.Add(Range:=.Parent).Range.Text = "Cross referencing error"
                    .Execute
                End With
            Loop
        End With
    End With

End Sub

来源：https://stackoverflow.com/questions/52159944/using-excel-vba-how-to-search-for-a-specific-word-and-insert-comments-against-t