Sub Demo()
Application.ScreenUpdating = False
Dim StrClr As String
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .Wrap = wdFindContinue
    .Font.ColorIndex = wdAuto
    .Replacement.Font.Hidden = True
    .Execute Replace:=wdReplaceAll
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindStop
    .Font.Hidden = False
    .Execute
  End With
  Do While .Find.Found
    StrClr = GetClr(.Characters.First.Font.Color, .Characters.First.Font.ColorIndex)
    If .Font.ColorIndex <> wdAuto Then
      With .Duplicate
        .Collapse wdCollapseStart
        .Text = "<" & StrClr & ">"
        .Font.ColorIndex = wdAuto
      End With
      With .Duplicate
        .Collapse wdCollapseEnd
        If .Characters.Last.Previous = vbCr Then .End = .End - 1
        .Text = "</" & StrClr & ">"
        .Font.ColorIndex = wdAuto
      End With
    End If
    .Collapse wdCollapseEnd
    If (ActiveDocument.Range.End - .End) < 2 Then Exit Do
    .Find.Execute
  Loop
End With
ActiveDocument.Range.Font.Hidden = False
Application.ScreenUpdating = True
End Sub

Function GetClr(RGB_Val As Long, Optional i As Long) As String
Dim StrTmp As String
If RGB_Val < 0 Or RGB_Val > 16777215 Then RGB_Val = 0
StrTmp = StrTmp & " R: " & RGB_Val \ 256 ^ 0 Mod 256
StrTmp = StrTmp & " G: " & RGB_Val \ 256 ^ 1 Mod 256
StrTmp = StrTmp & " B: " & RGB_Val \ 256 ^ 2 Mod 256
Select Case i
  Case 0: StrTmp = StrTmp & " - Auto (Default)"
  Case 1: StrTmp = StrTmp & " - Black"
  Case 2: StrTmp = StrTmp & " - Blue"
  Case 3: StrTmp = StrTmp & " - Turquoise"
  Case 4: StrTmp = StrTmp & " - Bright Green"
  Case 5: StrTmp = StrTmp & " - Pink"
  Case 6: StrTmp = StrTmp & " - Red"
  Case 7: StrTmp = StrTmp & " - Yellow"
  Case 8: StrTmp = StrTmp & " - White"
  Case 9: StrTmp = StrTmp & " - Dark Blue"
  Case 10: StrTmp = StrTmp & " - Teal"
  Case 11: StrTmp = StrTmp & " - Green"
  Case 12: StrTmp = StrTmp & " - Violet"
  Case 13: StrTmp = StrTmp & " - Dark Red"
  Case 14: StrTmp = StrTmp & " - Dark Yellow"
  Case 15: StrTmp = StrTmp & " - 50% Gray"
  Case 16: StrTmp = StrTmp & " - 25% Gray"
  Case Else:  StrTmp = StrTmp & " - User Defined"
End Select
GetClr = StrTmp
End Function