View Single Post
 
Old 06-11-2014, 10:10 AM
NobodysPerfect NobodysPerfect is offline Windows 8 Office 2010 32bit
Competent Performer
 
Join Date: Jan 2014
Location: Germany
Posts: 136
NobodysPerfect is on a distinguished road
Default

Ok, here it comes:

Code:
Sub HighlightRanges()
Dim doc As Document: Set doc = ActiveDocument
Dim SRange As Range: Set SRange = doc.Range
Dim RePaintText As Variant
Dim i As Long

    RePaintText = Array("Pos.", "Wert", "077.0087")
    
    Application.ScreenUpdating = False
    
    ClearFindnReplace
    Options.DefaultHighlightColorIndex = wdViolet
    With SRange.Find
        .Text = "Pos.*Wert"
        .Replacement.Highlight = True
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

    ClearFindnReplace
    Options.DefaultHighlightColorIndex = wdYellow
    With SRange.Find
        .Replacement.Highlight = True
        For i = LBound(RePaintText) To UBound(RePaintText)
            .Text = RePaintText(i)
            .Execute Replace:=wdReplaceAll
        Next i
    End With

End Sub

Sub ClearFindnReplace()

    With Selection.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = ""
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindStop
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
    End With
    
End Sub
Data between "Pos." and "Wert" shall be highlighted - with some exceptions within the highlighted area. So part one highlights the range from "Pos." to "Wert", part two 're-paints' given strings (incl. "Pos." and "Wert").

As I wrote, works fine, but ignores tables.

Thanks
NP
Reply With Quote