Word VBA/利阿賀拿

英文斷字

Option Explicit

Public Sub extractWordFromDocument()
    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 lfON As Boolean
    Dim cntLink As Integer
    Dim i As Integer
    
    Set myDoc = Documents("文件1")       '執行前，請確認英文文稿的 Word 檔名
    Set newDoc = Documents.Add
    ename = newDoc.Name
    

    cntLink = myDoc.Hyperlinks.Count

    For i = cntLink To 1 Step -1
        myDoc.Hyperlinks(i).Range.Delete
    Next

    
    For Each char In myDoc.Characters
        If Asc(char) < 65 Or (Asc(char) > 90 And Asc(char) < 97) Or Asc(char) > 122 Then
            If lfON Then
            Else
                newDoc.Content.InsertAfter Text:=vbCrLf
                lfON = True
            End If
        Else                                                                           '文字
            newDoc.Content.InsertAfter Text:=char
            lfON = False
        End If
    Next

End Sub

英中斷句

Option Explicit
Public cname As String
Public ename As String
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 = Documents("文件1")       '執行前，請確認中文文稿的 Word 檔名
    Set newDoc = Documents.Add
    cname = newDoc.Name
    
    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
'                Else
'                    newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf
'                    newDoc.Content.InsertAfter Text:="<p class='chinese'>"
                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 charSaved As String
    
    Dim response As Integer
    Dim cntLink As Integer
    Dim i As Integer
    
    Set myDoc = Documents("文件1")       '執行前，請確認英文文稿的 Word 檔名
    Set newDoc = Documents.Add
    ename = newDoc.Name
    

    cntLink = myDoc.Hyperlinks.Count

    For i = cntLink To 1 Step -1
        myDoc.Hyperlinks(i).Range.Delete
    Next

    charSaved = ""
    periodFound = False
    newDoc.Content.InsertAfter Text:="<p class='english'>"
    
    i = 1
    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
'                Else
'                    newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf
'                    newDoc.Content.InsertAfter Text:="<p class='english'>"
                End If
            Case "."
                If (myDoc.Characters(i - 1) = ")" Or myDoc.Characters(i - 1) = Chr(41384)) Then '如果文章的第一個右括弧在第一個位置時，程式將無法執行，因為 i-1 超出範圍
                        charSaved = char                            '斷句符號暫存
                        periodFound = True
                Else
                    If (Asc(myDoc.Characters(i - 2)) < 65) Or (Asc(myDoc.Characters(i - 2)) > 122) Then '如果文章的第一個句點在第二個位置時，程式將無法執行，因為 i-2 超出範圍
                        newDoc.Content.InsertAfter Text:=char
                    Else
                        charSaved = char                            '斷句符號暫存
                        periodFound = True
                    End If
                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
        i = i + 1
    Next


End Sub