"Word VBA/利阿賀拿" 修訂間的差異

於 2018年4月18日 (三) 05:09 的修訂

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 = Documents("文件1")
'    Set newDoc = Documents.Add
    
    For Each para In myDoc.Paragraphs
'        newDoc.Content.InsertAfter Text:=word
        response = MsgBox(para, vbOKCancel)
        If response = vbCancel Then Exit For
    Next

End Sub
Sub convertChineseToWiki()
    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 openDoubleQuoteFound As Boolean     '發現第一個雙引號

    Dim charSaved As String
    
    Dim response As Integer
    Dim cntLink As Integer
    Dim i As Integer
    
    Set myDoc = ThisDocument
    Set newDoc = Documents.Add
    
    cntLink = myDoc.Hyperlinks.Count
    
    For i = cntLink To 1 Step -1
        myDoc.Hyperlinks(i).Range.Delete
    Next
    
    charSaved = ""
    periodFound = False
'    openDoubleQuoteFound = False
    newDoc.Content.InsertAfter Text:="<p class='chinese'>"
    
    For Each char In myDoc.Characters


        Select Case char
            Case vbCr, vbLf, Chr(11)                        '分行符號

                If periodFound Then
                    newDoc.Content.InsertAfter Text:=charSaved
                    newDoc.Content.InsertAfter Text:="</p>" & vbCrLf & vbCrLf
                    newDoc.Content.InsertAfter Text:="<p class='chinese'>"
                    periodFound = False
                End If
            Case "。", ".", "！", "!", "？", "?", "；"      '斷句符號
                charSaved = char                            '斷句符號暫存
                periodFound = True

            Case "」", "』", ")", Chr(41384)                '右引號
                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
                Else
                    newDoc.Content.InsertAfter Text:=char
                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
Sub convertEnglishToWiki()
    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 openDoubleQuoteFound As Boolean     '發現第一個雙引號

    Dim charSaved As String
    
    Dim response As Integer
    Dim cntLink As Integer
    Dim i As Integer
    
    Set myDoc = ThisDocument
    Set newDoc = Documents.Add
    
    cntLink = myDoc.Hyperlinks.Count
    
    For i = cntLink To 1 Step -1
        myDoc.Hyperlinks(i).Range.Delete
    Next
    
    charSaved = ""
    periodFound = False
'    openDoubleQuoteFound = False
    newDoc.Content.InsertAfter Text:="<p class='english'>"
    
    For Each char In myDoc.Characters


        Select Case char
            Case vbCr, vbLf, Chr(11)                        '分行符號

                If periodFound Then
                    newDoc.Content.InsertAfter Text:=charSaved
                    newDoc.Content.InsertAfter Text:="</p>" & vbCrLf & vbCrLf
                    newDoc.Content.InsertAfter Text:="<p class='english'>"
                    periodFound = False
                End If
            Case "。", ".", "！", "!", "？", "?", "；"      '斷句符號
                charSaved = char                            '斷句符號暫存
                periodFound = True

            Case "」", "』", ")", Chr(41384)                '右引號
                If periodFound Then
                    newDoc.Content.InsertAfter Text:=charSaved
                    newDoc.Content.InsertAfter Text:=char & "</p>" & vbCrLf & vbCrLf
                    newDoc.Content.InsertAfter Text:="<p class='english'>"
                    periodFound = False
                Else
                    newDoc.Content.InsertAfter Text:=char
                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='english'>"
                    newDoc.Content.InsertAfter Text:=char
                    periodFound = False
                Else
                    newDoc.Content.InsertAfter Text:=char
                End If
        End Select
    
    Next


End Sub