Oscar Sun

                  Sub 漢籍電子文獻資料庫文本整理_以轉貼到中國哲學書電子化計劃()
Dim rng As Range, d As Document, a
Dim rp As Variant, i As Byte
Set d = ActiveDocument
If d.path <> "" Or d.Content.text <> Chr(13) Then Exit Sub
rp = Array("(", "{{", ")", "}}", ChrW(160), "", "【圖】", "", _
     "^p^p", "^p", _
     ChrW(13) & ChrW(45) & ChrW(13) & ChrW(13) & ChrW(11), "^p", _
     ChrW(13) & ChrW(45) & ChrW(13), "^p")
     '原來「ChrW(13) & ChrW(45) & ChrW(13) & ChrW(13) & ChrW(11)」是其中有表格啊
Set rng = d.Range
rng.Paste
漢籍電子文獻資料庫文本整理_注文前後加括號
For Each a In rng.Characters
    If a.Font.Size = 10 Then
        Select Case a.Font.Color
            Case 255, 9915136
                a.Delete
        End Select
    End If
Next a
rng.Cut
rng.PasteAndFormat wdFormatPlainText
For i = 0 To UBound(rp)
    rng.Find.Execute rp(i), , , , , , , wdFindContinue, , rp(i + 1), wdReplaceAll
    i = i + 1
Next i
Beep
End Sub

Sub 漢籍電子文獻資料庫文本整理_注文前後加括號()
Dim rng As Range, fColor As Long, flg As Boolean
Const fSize As Byte = 10
Set rng = ActiveDocument.Range
rng.Collapse wdCollapseStart
fColor = rng.Font.Color
Do While rng.End < rng.Document.Range.End - 1
    rng.move wdCharacter, 1
    If rng.Font.Color = 204 And rng.Font.Size = 11 Then
        rng.Delete
    ElseIf (rng.Font.Color <> fColor Or rng.Font.Size = fSize) And _
                (rng.Font.Color <> 234 And rng.Font.Bold = False) Then '紅字+粗體為檢索結果
        If flg = False Then
            If rng.Font.Color <> -16777216 Then
                rng.InsertBefore "("
                rng.Characters(1).Font.Color = rng.Next.Next.Font.Color
                rng.Characters(1).Font.Size = rng.Next.Next.Font.Size
                flg = True
            End If
        End If
    ElseIf rng.Font.Color = fColor And flg = True Then
        rng.Previous.InsertAfter ")"
        flg = False
    End If
Loop
Beep
End Sub