添加指向特定单词的旁注

Add side comments that point to specific words

我有2个word文档:

示例:Term=Winnie the poop Suggestion=正确的拼写是 Winnie the pooh。

此时我的代码添加了注释,但它突出显示了整个句子(Winnie the poop 很可爱)。我如何link对错误的特定术语(Winnie the poop)的建议?


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

当您执行查找时,范围或选择会重新定义为找到的匹配项。如果您随后要进一步处理找到的范围,这将很有用。在大多数情况下,可以使用文档的 built-in 范围对象。

例外情况是您需要将找到的范围用作另一个操作的输入参数,就像添加评论一样。在您的代码中,当您使用 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