Sub 中國哲學書電子化計劃_表格轉文字(ByRef r As Range)
On Error GoTo eH
'Dim d As Document
Dim tb As Table, c As Cell ', ci As Long
'Set d = ActiveDocument
If r.Tables.Count > 0 Then
    For Each tb In r.Tables
        tb.Columns(1).Delete
        Set r = tb.ConvertToText()
    Next tb
End If
Exit Sub
eH:
Select Case Err.Number
    Case 5992 '無法個別存取此集合中的各欄，因為表格中有混合的儲存格寬度。
        For Each c In tb.Range.Cells
'            ci = ci + 1
'            If ci Mod 3 = 2 Then
                'If VBA.IsNumeric(VBA.Left(c.Range.text, VBA.InStr(c.Range.text, "?") - 1)) Then
                If VBA.InStr(c.Range.text, ChrW(160) & ChrW(47)) > 0 Then
                    c.Delete  '刪除編號之儲存格
                End If
'            End If
        Next c
        Resume Next
    Case Else
        MsgBox Err.Number & Err.Description
        End
End Select
End Sub

Sub 中國哲學書電子化計劃_註文變小正文回大()
Dim slRng As Range, a
Set slRng = Selection.Range
中國哲學書電子化計劃_表格轉文字 slRng
For Each a In slRng.Characters
    Select Case a.Font.Color
        Case 34816, 8912896
            a.Font.Size = 14
        Case 0
            a.Font.Size = 30
    End Select
Next a
End Sub
Sub 中國哲學書電子化計劃_去掉註文保留正文()
Dim slRng As Range, a
If ActiveDocument.Characters.Count = 1 Then Selection.Paste
If Selection.Type = wdSelectionIP Then ActiveDocument.Select
Set slRng = Selection.Range
中國哲學書電子化計劃_表格轉文字 slRng
For Each a In slRng.Characters
    Select Case a.Font.Color
        Case 34816, 8912896
            If a.Font.Size <> 12 Then Stop
            a.Delete
        Case 254
            If a.Font.Size = 9 Then a.Delete
    End Select
Next a
Beep 'MsgBox "done!", vbInformation
End Sub
Sub 中國哲學書電子化計劃_註文前後加括弧()
Dim slRng As Range, a, flg As Boolean 'Alt+1
If Documents.Count = 0 Then GoTo a:
If ActiveDocument.Characters.Count = 1 Then
    Selection.Paste
ElseIf ActiveDocument.Characters.Count > 1 Then
    For Each a In Documents
        If a.path = "" Or a.Characters.Count = 1 Then
            a.Range.Paste
            a.Activate
            a.ActiveWindow.Activate
            flg = True
            Exit For
        End If
    Next a
    If flg = False Then GoTo a
Else
a: Documents.Add
    Selection.Paste
End If
If Selection.Type = wdSelectionIP Then ActiveDocument.Select
Set slRng = Selection.Range
中國哲學書電子化計劃_表格轉文字 slRng
For Each a In slRng.Characters
    Select Case a.Font.Color
        Case 34816, 8912896, 15776152, 34816
            If flg = False Then
                a.Select
                Selection.Range.InsertBefore "（"
                a.Font.Size = a.Next.Font.Size
                a.Font.Color = a.Next.Font.Color
                flg = True
            End If
        Case 0, 15595002, 15649962
            If flg Then
                a.Select
                Selection.Range.InsertBefore "）"
                flg = False
            End If
    End Select
Next a
slRng.Find.Execute "（（", True, , , , , , , , "（", wdReplaceAll
slRng.Find.Execute "））", True, , , , , , , , "）", wdReplaceAll
Beep
'MsgBox "done!", vbInformation
End Sub