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

使用Excel VBA，如何搜索特定单词并在Word文档中针对该单词插入注释？

1 个答案: