添加指向特定单词的旁注

Question

我有 2 个 Word 文档：

• 用于检查错误单词的文档。文档中的例句：便便的维尼很可爱。
• 带有矩阵的文档，其中包含要搜索的错误单词和建议。

示例：术语=Winnie the poop 建议=正确的拼写是Winnie the pooh。

此时，我的代码添加了一条注释，但它突出显示了整个句子（小熊维尼很可爱）。如何将建议与错误的特定术语（小熊维尼）联系起来？

---

Sub Search4WrongWords()
Dim MatrixCounter As Integer        'Counter to search for all terms in the Matrix
Dim DocToValidate As Word.Document  'Document to validate and search for wrong words
Dim MaxWordsInMatrix As Integer    'Total rows in Matrix
Const ColumnWithTerm = 2           'Matrix wrong terms Example: Winnie the Poop
Const ColumnWithSuggestion = 3     'Matrix suggested term. Example: Winnie The Pooh

MatrixCounter = 0

    DocumentPath = "C:\Folder\File_to_validate.docx"      'File to validate for wrong words
    MatrixPath = "C:\Folder\Matrix_with_suggestions.docx"  'Matrix with terms & suggestions
    
    Set MatrixDoc = Documents.Open(MatrixPath)             'File path is provided by user
    Set DocToValidate = Documents.Open(DocumentPath)       'File path is provided by user
    
    MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count  'Total rows in matrix

    For MatrixCounter = 2 To MaxWordsInMatrix  'counter =2 to avoid reading matrix header row
       
        With DocToValidate.range.Find
          .Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text) - 2)))
          .Format = True
          .MatchCase = False
          .MatchWholeWord = True
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .NoProofing = False
 
          Do While .Execute(Forward:=True) = True
             suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).range.Text
             DocToValidate.Comments.Add DocToValidate.range, Text:=suggestion
           Loop   'do while

        End With  'DocToValidate
    Next 'MatrixCounter
End Sub

Answer 1

当您执行查找时，范围或选择将重新定义为找到的匹配项。如果您要进一步处理找到的范围，这非常有用。在大多数情况下，可以使用文档的内置范围对象。

例外情况是您需要使用找到的范围作为另一个操作的输入参数，就像添加注释一样。在代码中，当您使用 DocToValidate.range 作为注释的锚点而不是引用找到的匹配项时，它引用整个文档。

您可以通过使用范围对象变量来克服这个问题，如下所示。

Sub Search4WrongWords()
    Dim MatrixCounter As Integer        'Counter to search for all terms in the Matrix
    Dim DocToValidate As Word.Document  'Document to validate and search for wrong words
    Dim MaxWordsInMatrix As Integer    'Total rows in Matrix
    Const ColumnWithTerm = 2           'Matrix wrong terms Example: Winnie the Poop
    Const ColumnWithSuggestion = 3     'Matrix suggested term. Example: Winnie The Pooh

    MatrixCounter = 0

    DocumentPath = "C:\Folder\File_to_validate.docx"      'File to validate for wrong words
    MatrixPath = "C:\Folder\Matrix_with_suggestions.docx"  'Matrix with terms & suggestions
    
    Set MatrixDoc = Documents.Open(MatrixPath)             'File path is provided by user
    Set DocToValidate = Documents.Open(DocumentPath)       'File path is provided by user
    
    MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count  'Total rows in matrix

    Dim findRange As Word.Range
    Dim suggestion As String
    
    For MatrixCounter = 2 To MaxWordsInMatrix  'counter =2 to avoid reading matrix header row
        Set findRange = DocToValidate.Range    'necessary to ensure that the full document is being searched with each iteration
        With findRange.Find
            .Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text) - 2)))
            .MatchCase = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .NoProofing = False
            .Wrap = wdFindStop  'stops find at the end of the document
 
            Do While .Execute(Forward:=True) = True
                'findRange has now been redefined to the found match
                suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).Range.Text
                DocToValidate.Comments.Add findRange, Text:=suggestion
                findRange.Collapse wdCollapseEnd    'necessary to avoid getting into endless loop
            Loop   'do while

        End With  'findRange.Find
    Next 'MatrixCounter
End Sub