Add side comments that point to specific words-CodePudding

I have 2 word documents:

Document to review for wrong words. Sample sentence in document: Winnie the poop is cute.
Document with a matrix that contains wrong words to search for, and a suggestion.

Example: Term=Winnie the poop Suggestion=Correct spelling is Winnie the pooh.

At this point my code adds a comment, but it highlights the whole sentence (Winnie the poop is cute). How do I link the suggestion to the specific term that is wrong (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

CodePudding user response：

When you execute a find the range, or selection, is redefined to the found match. This is useful if you are then going to further process the found range. In most circumstances it is possible to use the built-in range object of a document.

The exception to this is where you need to use the found range as an input parameter for another operation, as you do with adding a comment. In your code when you use DocToValidate.range as the anchor for the comment instead of referring to the found match it refers to the entire document.

You can overcome this by using an object variable for the range, as below.

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