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

Формулировка задачи:

Пытаюсь написать макрос чтобы поменять цвет шрифта для все цифр в документе, сделать их скажем зелеными. В начале пытался использовать [0-9], не разобрался решил прописать для каждой цифры: Записал замену всех цифр 1 (для начала) на такие же но

зеленые

. Однако получившийся макрос не видит цвет, хотя при автозамене руками - все нормально. пробовал добавить строчку

                    Листинг программы
                
.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

Буду очень рад идеям.

Решение задачи: «Макрос, чтобы "покрасить" текст в Word-е»

textual
                            Листинг программы 
                        
 
                        
                          
                    
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