Bedingte Formatierung für einen Text in Word 2013

10.06.2015 09:00 Frau Müller: BlaBlaBla Bla

Sub FindAndColor()
    Dim regex As Object, matches As Object, match As Object, strName As String
    'Regex Objekt und Optionen  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True: regex.Global = True
    ' Zur Eingabe des Namens auffordern  
    strName = InputBox("Geben sie den Namen ein:", "Abschnitte hervorheben", "Frau Müller")  
    ' Wenn Name leer oder Abbrechen, Prozedur beenden  
    If strName = "" Then Exit Sub  
    'Suchpattern setzen  
    regex.Pattern = "(" & strName & ":[\s\S]*?)(\d{2}\.\d{2}\.\d{2,4}|$)"  
    ' Vorherige markierung entfernen  
    Selection.Find.ClearHitHighlight
    With ActiveDocument
        'SUche ausführen  
        Set matches = regex.Execute(.Content.Text)
        If matches.Count > 0 Then
            ' Für jeden Treffer die betreffende Stelle markieren  
            For Each match In matches
                Selection.HomeKey Unit:=wdStory
                Selection.Find.HitHighlight FindText:=match.Submatches(0), HIghlightColor:=wdColorYellow, MatchCase:=False, MatchWholeWord:=False, MatchWildcards:=False, MatchAllWordForms:=False, MatchSoundsLike:=False
            Next
        End If
    End With
    Set regex = Nothing
End Sub

Sub FindAndColor()
    Dim regex As Object, matches As Object, match As Object, strName As String
    'Regex Objekt und Optionen  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True: regex.Global = True
    ' Zur Eingabe des Namens auffordern  
    strName = InputBox("Geben sie den Namen ein:", "Abschnitte hervorheben", "Frau Müller")  
    ' Wenn Name leer oder Abbrechen, Prozedur beenden  
    If strName = "" Then Exit Sub  
    'Suchpattern setzen  
    regex.Pattern = "(" & strName & ":[\s\S]*?)(\d{2}\.\d{2}\.\d{2,4}|$)"  
    ' Vorherige markierung entfernen  
    With ActiveDocument
        'Suche ausführen  
        Set matches = regex.Execute(.Content.Text)
        If matches.Count > 0 Then
            Selection.HomeKey Unit:=wdStory
            ' Für jeden Treffer die betreffende Stelle markieren  
            For Each match In matches
                With Selection.Find
                    .ClearFormatting
                    .Text = match.Submatches(0)
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchAllWordForms = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .Execute
                    Selection.Range.HighlightColorIndex = wdYellow
                End With
            Next
        End If
    End With
    Set regex = Nothing
End Sub