Используя Excel VBA, как искать определенное слово и вставлять комментарии к этому слову в документе Word?

Question

Я пытаюсь создать инструмент на основе Excel, который проверяет документы Word на наличие ошибок. Я хочу, чтобы этот инструмент искал слово / предложение и вставлял комментарий к нему. Я написал код (см. Ниже), который может выделить слово / предложение, но не может вставить комментарий.

Вот мой код:

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

Answer 1

Поскольку вы говорите, что действуете из приложения Excel, тогда неквалифицированный объект Selection будет ссылаться на хост-приложение, т.е. он будет возвращать Excel Selection отредактировано для добавления кода приложения хоста Word

Следовательно, вы должны явно квалифицировать объект приложения Word как Parent требуемого Selection объекта (хотя я не вижу никаких следов в вашем коде, хотя ...)

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

---

Кстати, вам не нужны все эти операции выбора / выделения, и вы можете напрямую работать с нужными объектами

например, цикл Do While .Find.Found = True может превратиться в

        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

---

при использовании Word в качестве хост-приложения приведенный выше код упростится до:

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