On Error GoTo ErrHandle Set myRange = ActiveDocument.Range(Selection.Start, ActiveDocument.Content.End) For Each iChar In myRange.Characters Selection.MoveRight Unit:=wdCharacter, Count:=1 If Selection.Font.ColorIndex = 2 Then MsgBox iChar Next Exit Sub ErrHandle: MsgBox "Error number: " + Str$(Err) + Chr(13) + Error$(Err), 48, m_Title
②第二种代码
Dim n As Integer, Info As String With Selection.Find .Parent.HomeKey wdStory .ClearFormatting .Font.Color = wdColorBlue Do While .Execute n = n + 1 Info = Info & n & vbTab & .Parent & vbCrLf '提取找到的文本 .Parent.Delete '删除找到的文本(蓝色字体) Loop End With If Info = "" Then MsgBox "未找到指定颜色字体" Else Documents.Add.Content = Info