Word VBA - Franco's Macros

word_vba.vb

Sub AAA_underline_uber()
'
' underline_fluong Macro
' Find instances of text from searchTextArray which are not underlined and:
'  - extend selection to end of line`
'  - underline it
'

Dim searchTextArray(1 To 4) As String
searchTextArray(1) = "fluong@"
searchTextArray(2) = "blah@"
searchTextArray(3) = "root@"
searchTextArray(4) = " >> Subcase"

Dim iCount As Integer
Dim searchText As Variant
Dim Found As Boolean

For Each searchText In searchTextArray
    iCount = 0
    Found = True
    Do While Found And iCount < 1000
        iCount = iCount + 1
        'goto beginning of document
        Selection.HomeKey Unit:=wdStory
        'perform search
        With Selection.Find
            .ClearFormatting
            .Forward = True
            .Wrap = wdFindContinue
            .Text = searchText
            .Font.Underline = wdUnderlineNone
            .Execute
        End With
        Selection.Find.Execute
        Found = Selection.Find.Found
        'underline if found
        If Found Then
            Selection.EndOf Unit:=wdLine, Extend:=wdExtend
            Selection.Font.Underline = wdUnderlineSingle
        End If
    Loop
    
Next searchText

       
End Sub


Sub ABA_highlight_test_results()
'
' highlight_test_results Macro by @francisluong
' Find instances of "Test Result:" which are not highlighted and:
'  - extend selection to end of line`
'  - highlight it
'
 
    Dim iCount As Integer
    Dim searchDone As Boolean
    Dim searchTextArray(0 To 0) As String
    Dim searchText As Variant
    searchTextArray(0) = "Test Result:"
    Options.DefaultHighlightColorIndex = wdYellow
   
    For Each searchText In searchTextArray
   
        Selection.HomeKey Unit:=wdStory
               
        searchDone = False
        iCount = 0
       
        Do While searchDone = False And iCount < 1000
           
            iCount = iCount + 1
             
            Selection.HomeKey Unit:=wdStory
            With Selection.Find
                .ClearFormatting
                .Forward = True
                .Wrap = wdFindContinue
                .Text = searchText
                .Highlight = False
            End With
            Selection.Find.Execute
           
            If Selection.Find.Found Then
                Selection.EndOf Unit:=wdLine, Extend:=wdExtend
                Selection.Range.HighlightColorIndex = wdYellow
            Else: searchDone = True
            End If
        Loop
    Next searchText
       
End Sub

Sub ABB_highlight_brute()
'
' Find instances of text from searchTextArray and:
'  - extend selection to end of line`
'  - highlight it
'  - dumb search and doesn't depend on not found

Dim searchTextArray(1 To 1) As String
searchTextArray(1) = "Test Result:"

Dim iCount As Integer
Dim searchText As Variant
Dim Found As Boolean
Dim lastPage As Integer
Dim thisPage As Integer

For Each searchText In searchTextArray
    iCount = 0
    lastPage = 0
    thisPage = 0
    Found = True
    'goto beginning of document
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Text = searchText
    End With
    Do While Selection.Find.Execute And lastPage <= thisPage And iCount < 99999
        iCount = iCount + 1
        'perform search
        Found = Selection.Find.Found
        lastPage = thisPage
        thisPage = Selection.Information(wdActiveEndPageNumber)
        'underline if found
        If Found Then
            Selection.EndOf Unit:=wdLine, Extend:=wdExtend
            Selection.Range.HighlightColorIndex = wdYellow
            lastPage = thisPage
            thisPage = Selection.Information(wdActiveEndPageNumber)
        End If
        Selection.EndKey
                
    Loop
    
Next searchText

       
End Sub

Sub ACA_snipsnip_bold_italic()
'
' Find instances of "-- snip, snip --" which and:
'  - replace with same text in bold and italic
'
'

Dim searchTextArray(1 To 1) As String
searchTextArray(1) = "-- snip, snip --"

Dim iCount As Integer
Dim searchText As Variant
Dim Found As Boolean

For Each searchText In searchTextArray

    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = searchText
        With .Replacement
            .ClearFormatting
            .Font.Bold = True
            .Font.Italic = True
        End With
        .Execute Format:=True, Replace:=wdReplaceAll
    End With

Next searchText

End Sub