福音原則
Option Explicit
Sub testCopyByCharacters()
' 用 character (字) 為單位複製文件,統計數字顯示完整抄錄
Dim myDoc As Document
Dim newDoc As Document
Dim char As Variant
Dim word As Variant
Dim para As Variant
Dim response As Integer
Set myDoc = ThisDocument
Set newDoc = Documents.Add
For Each char In myDoc.Characters
newDoc.Content.InsertAfter Text:=char
' response = MsgBox(char, vbOKCancel)
' If response = vbCancel Then Exit For
Next
End Sub
Sub testCopyByWords()
' 用 word (詞) 為單位複製文件,統計數字顯示有短少的限象
Dim myDoc As Document
Dim newDoc As Document
Dim char As Variant
Dim word As Variant
Dim para As Variant
Dim response As Integer
Set myDoc = ThisDocument
Set newDoc = Documents.Add
For Each word In myDoc.Words
newDoc.Content.InsertAfter Text:=word
' response = MsgBox(word, vbOKCancel)
' If response = vbCancel Then Exit For
Next
End Sub
Sub testCopyByParagraphs()
' 用 paragraph (段) 為單位複製文件,統計數字顯示完整抄錄
Dim myDoc As Document
Dim newDoc As Document
Dim char As Variant
Dim word As Variant
Dim para As Variant
Dim response As Integer
Set myDoc = ThisDocument
Set newDoc = Documents.Add
For Each para In myDoc.Paragraphs
' 若宣告 para 為 Paragraph,下行指令執行時會發生錯誤
newDoc.Content.InsertAfter Text:=para
' response = MsgBox(para, vbOKCancel)
' If response = vbCancel Then Exit For
Next
End Sub
Sub convertToWiki()
Dim myDoc As Document
Dim newDoc As Document
Dim char As Variant
Dim word As Variant
Dim para As Variant
Dim periodFound As Boolean
Dim charSaved As String
Dim response As Integer
Set myDoc = ThisDocument
Set newDoc = Documents.Add
charSaved = ""
periodFound = False
' newDoc.Content.InsertAfter Text:="<p class='chinese'>"
For Each char In myDoc.Characters
Select Case char
Case vbCr, vbLf, Chr(11)
Case "。", ".", "!", "!", "?", "?"
charSaved = char
periodFound = True
Case "」", "』", ")"
If periodFound Then
newDoc.Content.InsertAfter Text:=charSaved
newDoc.Content.InsertAfter Text:=char & "</p>" & vbCrLf & vbCrLf
' newDoc.Content.InsertAfter Text:="<p class='chinese'>"
periodFound = False
End If
Case Else
If periodFound Then
newDoc.Content.InsertAfter Text:=charSaved
newDoc.Content.InsertAfter Text:="</p>" & vbCrLf & vbCrLf
' newDoc.Content.InsertAfter Text:="<p class='chinese'>"
newDoc.Content.InsertAfter Text:=char
periodFound = False
Else
newDoc.Content.InsertAfter Text:=char
End If
End Select
Next
End Sub