漢籍電子文獻資料庫文本整理_以轉貼到中國哲學書電子化計劃 | by Oscar Sun on SnipSave | Web-based code snippet manager for developers
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), "")
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
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 Integer, 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
留言