none
How to add a comment to terms found via Macro (Word 2010)? RRS feed

  • Question

  • I have the macro below working fine. It looks for a given term and highlights it with red. I would like to add a comment (comment.add) to each instance of the found word. Any way that can be done?

    Sub WordsToAvoid()
    '
    ' WordsToAvoid Macro
    '
        Options.DefaultHighlightColorIndex = wdRed
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = True
        With Selection.Find
            .Text = "we understand"
            .Replacement.Text = "we understand"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "leverage our experience"
            .Replacement.Text = "leverage our experience"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "thank you for the opportunity"
            .Replacement.Text = "thank you for the opportunity"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    End Sub

    Thursday, September 6, 2012 3:37 PM

Answers

  • Thanks Guys.

    I ended up getting this to work:

    Sub HighlightCrutchWords()
    
    'clean up excess spaces
    Call RemoveExcessSpaces
    
    'now find the terms and add a comment explaining why they are no good in proposals
    
        Dim range As range
        Dim i As Long
        Dim TargetList
        
        TargetList = Array("we understand", "leverage our experience", "thank you for the opportunity", "we look forward to")
        
        For i = 0 To UBound(TargetList)
        
        Set range = ActiveDocument.range
        
        With range.Find
        .Text = TargetList(i)
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
            
        Do While .Execute(Forward:=True) = True
            
            If TargetList(i) = "we understand" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Never use the word " & Chr(34) & "understand" & Chr(34) & _
                " in a proposal, other than in a section heading. To say " & Chr(34) & "we understand your requirements" & Chr(34) & _
                " obfuscates any understanding and is, by definition, an unsubstantiated claim. On the other hand, if you say something insightful about how you will fulfill the requirements, the reader will see that the bidder understands the requirements. Understanding should be demonstrated, not claimed."
            
            ElseIf TargetList(i) = "leverage our experience" Then
            range.Comments.Add range:=range, Text:="Crutch Words: " & Chr(34) & "Leverage" & Chr(34) & " is a word that some writers use when they " & _
                "know there is an advantage to be gained, but they don't know how to do it. Explain " & Chr(34) & "how" & Chr(34) & " rather than infer. Do not use " & Chr(34) & _
                "leverage" & Chr(34) & " in proposals unless you are talking about a mechanical lever and fulcrum."
            
            ElseIf TargetList(i) = "thank you for the opportunity" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Means, " & Chr(34) & "We are desperate for your business and don't really belong in the market." & Chr(34)
            
            ElseIf TargetList(i) = "we look forward to" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Just provide a call to action. If the RFP allows it, simply state when you will contact them to schedule an oral or finalist presentation. Make sure to follow the timeline addressed in the RFP."
            
            Else:
            range.HighlightColorIndex = wdRed
            
            End If
            
            Loop
        
        End With
        Next
    
    End Sub

    • Marked as answer by AroeiraDaIlha Friday, September 7, 2012 4:03 PM
    Friday, September 7, 2012 4:03 PM

All replies

  • I don't think there's a way to add comments using the Replace:=wdReplaceAll approach you've implemented here, but it's pretty straightforward to do it with a loop surrounding a search-once Find.Execute call:

    Sub contentInsert()
        Call ActiveDocument.Content.InsertAfter("Test" & Chr(13) & "Not" & Chr(13) & "Test" & _
                        Chr(13) & "Not" & Chr(13) & "Test" & Chr(13) & "Not" & Chr(13))
    End Sub
    
    Sub commentAdd()
        Dim d As Document
        Dim r As Range
        Dim f As Find
        Dim s As Selection
        
        Set d = ActiveDocument
        Set r = d.Content
        Set f = r.Find
        
        r.Select
        
        With f
            .Text = "Test"
            .Wrap = wdFindStop
        End With
        
        Do While f.Execute
            With r
                .Select
                Call .Comments.Add(r, "Comment")
            End With
        Loop
        
    End Sub

    Paste this code into a module in a blank document, run contentInsert() to fill it with simple sample content, then run or step through commentAdd() to observe the logic.  Note that the r.Select calls are superfluous -- I just included them for clarity as to what happens when you call .Find.Execute on a Range object.

    • Marked as answer by AroeiraDaIlha Friday, September 7, 2012 4:03 PM
    • Unmarked as answer by AroeiraDaIlha Friday, September 7, 2012 4:03 PM
    Thursday, September 6, 2012 7:52 PM
  • I would probably do it as follows

    Sub WordsToAvoid()
    '
    ' WordsToAvoid Macro
    '
    Dim oRng As Range
    Dim i As Long
    Dim vFindText As Variant
    Dim vComment As Variant
    Const strFindText As String = "we understand|leverage our experience|thank you for the opportunity"
    Const strComment As String = "understand comment|leverage comment|opportunity comment"
    vFindText = Split(strFindText, "|")
    vComment = Split(strComment, "|")
    Set oRng = ActiveDocument.Range
    For i = 0 To UBound(vFindText)
        With oRng.Find
            Do While .Execute(FindText:=vFindText(i), MatchCase:=False, Forward:=True) = True
                oRng.HighlightColorIndex = wdRed
                oRng.Comments.Add oRng, vComment(i)
                oRng.Collapse wdCollapseEnd
            Loop
        End With
        Set oRng = ActiveDocument.Range
    Next i
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    Friday, September 7, 2012 9:02 AM
  • Thanks Guys.

    I ended up getting this to work:

    Sub HighlightCrutchWords()
    
    'clean up excess spaces
    Call RemoveExcessSpaces
    
    'now find the terms and add a comment explaining why they are no good in proposals
    
        Dim range As range
        Dim i As Long
        Dim TargetList
        
        TargetList = Array("we understand", "leverage our experience", "thank you for the opportunity", "we look forward to")
        
        For i = 0 To UBound(TargetList)
        
        Set range = ActiveDocument.range
        
        With range.Find
        .Text = TargetList(i)
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
            
        Do While .Execute(Forward:=True) = True
            
            If TargetList(i) = "we understand" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Never use the word " & Chr(34) & "understand" & Chr(34) & _
                " in a proposal, other than in a section heading. To say " & Chr(34) & "we understand your requirements" & Chr(34) & _
                " obfuscates any understanding and is, by definition, an unsubstantiated claim. On the other hand, if you say something insightful about how you will fulfill the requirements, the reader will see that the bidder understands the requirements. Understanding should be demonstrated, not claimed."
            
            ElseIf TargetList(i) = "leverage our experience" Then
            range.Comments.Add range:=range, Text:="Crutch Words: " & Chr(34) & "Leverage" & Chr(34) & " is a word that some writers use when they " & _
                "know there is an advantage to be gained, but they don't know how to do it. Explain " & Chr(34) & "how" & Chr(34) & " rather than infer. Do not use " & Chr(34) & _
                "leverage" & Chr(34) & " in proposals unless you are talking about a mechanical lever and fulcrum."
            
            ElseIf TargetList(i) = "thank you for the opportunity" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Means, " & Chr(34) & "We are desperate for your business and don't really belong in the market." & Chr(34)
            
            ElseIf TargetList(i) = "we look forward to" Then
            range.Comments.Add range:=range, Text:="Crutch Words: Just provide a call to action. If the RFP allows it, simply state when you will contact them to schedule an oral or finalist presentation. Make sure to follow the timeline addressed in the RFP."
            
            Else:
            range.HighlightColorIndex = wdRed
            
            End If
            
            Loop
        
        End With
        Next
    
    End Sub

    • Marked as answer by AroeiraDaIlha Friday, September 7, 2012 4:03 PM
    Friday, September 7, 2012 4:03 PM