Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim oRng As Range
Dim arrParts() As String
  For Each oPar In ActiveDocument.Range.Paragraphs
    Select Case oPar.Range.ListFormat.ListLevelNumber And oPar.Range.ListFormat.ListString <> vbNullString
      'Uses a standard ColorIndex value.
      Case 1: PaintFont oPar.Range, 1
      Case 2: PaintFont oPar.Range, 6
      Case 3: PaintFont oPar.Range, 12
      Case 4: PaintFont oPar.Range, 7
      Case 5: PaintFont oPar.Range, 11
      Case 6: PaintFont oPar.Range, 2
      Case 7: PaintFont oPar.Range, 3
      Case 8: PaintFont oPar.Range, 10
      Case 9: PaintFont oPar.Range, 13
    Case Else
      arrParts = Split(oPar.Range.Text, Chr(9))
      Select Case Len(arrParts(0))
        Case 19
          Set oRng = oPar.Range
          oRng.MoveStart wdCharacter, 19
          'Uses Red, Green, Blue color components.
          PaintFont oRng, 0, 155, 233
      End Select
    End Select
  Next
lbl_Exit:
Exit Sub
End Sub

Sub PaintFont(oRng As Range, lngColorIndex As Long, _
              Optional lngG As Long = -1, Optional lngB As Long = -1)
  If InStr(oRng.Text, ChrW(8211)) > 0 Then
    oRng.MoveEndUntil ChrW(8211), wdBackward
    oRng.End = oRng.End - 2
  Else
    oRng.End = oRng.End - 1
  End If
  If lngB = -1 Then
    oRng.Font.ColorIndex = lngColorIndex
  Else
    oRng.Font.Color = RGB(lngColorIndex, lngG, lngB)
  End If
End Sub