Макрос, чтобы "покрасить" текст в Word-е

.Font.color = wdColorGreen

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "1"
        .Replacement.Text = "1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Font.color = wdColorGreen
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Sub ColoredDigits()
'
' ColoredDigits Макрос
' Макрос записан 21.07.2011 VirtualLab
'
    Dim i As Long
    Selection.WholeStory
    Application.Browser.Previous
    Debug.Print Selection.StoryLength
    For i = 1 To Selection.StoryLength
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        'If (Asc(Selection.Characters.First) >= 48) And (Asc(Selection.Characters.First) <= 57) Then
        If IsNumeric(Selection.Characters.First) Then
            Debug.Print "Символ: "; Selection.Characters.First
            Debug.Print "ASCI code: "; Asc(Selection.Characters.First)
            Selection.Font.Color = wdColorGreen
        End If
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Next
    MsgBox "Ok!"
End Sub