Marcia,
Your paragraphs are styled using the ListParagraph Style which only has nine levels. In your original document you had used ListNumbering. In the new file you have manually added the 10th level and the new levels. Also you have to be consistent with formatting. There has to be a tab between the number and text. Try:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim oRng As Range
Dim arrParts() As String
Dim arrParts2() As String
For Each oPar In ActiveDocument.Range.Paragraphs
Select Case oPar.Range.ListFormat.ListLevelNumber And oPar.Range.ListFormat.ListString <> vbNullString
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, 20
PaintFont oRng, 6 '30 is not a valid colorindes (there are only 15).
End Select
End Select
Next
lbl_Exit:
Exit Sub
End Sub
Sub PaintFont(oRng As Range, lngColorIndex As Long)
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
oRng.Font.ColorIndex = lngColorIndex
End Sub
|