Microsoft Office Forums - View Single Post - [Solved] Need help in assigning color codes to each generation in a genealogy

gmaxey · 06-07-2019, 12:32 PM

For what you have shown, something like this:

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim oRng As Range
  For Each oPar In ActiveDocument.Range.Paragraphs
    Select Case oPar.Range.ListFormat.ListLevelNumber
      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
    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

Note the numbers passed to PaintFont correspond to various wdColorIndexes e.g., 1 is black, 6 is red etc.