Oscar Sun

                  Sub 內碼_檢字()
Dim d As Document, a, d1 As Document, x As String
Set d = ActiveDocument
Set d1 = Documents(1)
x = Replace(d1.Range.Text, Chr(13), "")
For Each a In d.Characters
    If Asc(a) <> 13 Then
        If InStr(x, a) > 0 Then
        'If Hex(AscW(a)) > "6938" And Hex(AscW(a)) < "2387F" Then
    '    If AscW(a) > -10162 And AscW(a) < 26409 Then
    '        Select Case Hex(AscW(a))
    '        Select Case AscW(a)
    '            Case 1
    '            Case Else
                If a.HighlightColorIndex <> 5 Then '紫紅色
                    a.Select
                    Stop
                    x = Replace(x, a, "")
                End If
    '        End Select
        End If
    End If
Next a
MsgBox "ok!", vbInformation
End Sub