①第一種代碼
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