使用 Excel VBA，如何搜索特定单词并在 Word 文档中针对该单词插入注释? [英] Using Excel VBA, how to search for a specific word and insert comments against that word in a Word document?

问题描述

我正在尝试创建一个基于 Excel 的工具，用于检查 Word 文档是否存在特定错误.我想要这个工具搜索一个词/句子并插入一个评论.我编写了一个代码(请参见下文)，它能够突出显示单词/句子，但是无法插入注释.

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.

这是我目前的代码:

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

推荐答案

既然你说你是从 Excel 应用程序内部执行的，那么一个不合格的 Selection 对象将引用宿主应用程序，即它'd 返回 Excel Selection编辑以添加 Word 主机应用程序代码

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

因此，您必须将 Word 应用程序对象明确限定为所需 Selection 对象的 Parent(不过，我在您的代码中看不到任何痕迹...)

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

例如 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 作为宿主应用程序，上面的代码将简化为:

---

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

这篇关于使用 Excel VBA，如何搜索特定单词并在 Word 文档中针对该单词插入注释?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！