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

出自 青少年追求卓越
前往： 導覽， 搜尋
小 (已匯入 1 筆修訂)
 
(未顯示同一使用者於中間所作的 2 次修訂)
行 1： 行 1：
 +
__TOC__
 +
=英文斷字=
 
<pre>
 
<pre>
 
Option Explicit
 
Option Explicit
  
−
Sub testCopyByCharacters()
+
Public Sub extractWordFromDocument()
−
' 用 character (字) 為單位複製文件，統計數字顯示完整抄錄
 
 
     Dim myDoc As Document
 
     Dim myDoc As Document
 
     Dim newDoc As Document
 
     Dim newDoc As Document
行 11： 行 12：
 
     Dim para As Variant
 
     Dim para As Variant
 
      
 
      
−
     Dim response As Integer
+
     Dim periodFound As Boolean
 +
 
 +
    Dim charSaved As String
 +
   
 +
    Dim lfON As Boolean
 +
    Dim cntLink As Integer
 +
    Dim i As Integer
 
      
 
      
−
     Set myDoc = ThisDocument
+
     Set myDoc = Documents("文件1")      '執行前，請確認英文文稿的 Word 檔名
 
     Set newDoc = Documents.Add
 
     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
 
     For Each char In myDoc.Characters
−
         newDoc.Content.InsertAfter Text:=char
+
         If Asc(char) < 65 Or (Asc(char) > 90 And Asc(char) < 97) Or Asc(char) > 122 Then
−
'       response = MsgBox(char, vbOKCancel)
+
            If lfON Then
−
'        If response = vbCancel Then Exit For
+
            Else
 +
                newDoc.Content.InsertAfter Text:=vbCrLf
 +
                lfON = True
 +
            End If
 +
        Else                                                                          '文字
 +
            newDoc.Content.InsertAfter Text:=char
 +
            lfON = False
 +
        End If
 
     Next
 
     Next
  
 
End Sub
 
End Sub
−
Sub testCopyByWords()
+
 
−
' 用 word (詞) 為單位複製文件，統計數字顯示有短少的限象
+
</pre>
 +
=英中斷句=
 +
<pre>
 +
Option Explicit
 +
Public cname As String
 +
Public ename As String
 +
Sub convertChineseToWiki()
 
     Dim myDoc As Document
 
     Dim myDoc As Document
 
     Dim newDoc As Document
 
     Dim newDoc As Document
行 31： 行 60：
 
     Dim word As Variant
 
     Dim word As Variant
 
     Dim para As Variant
 
     Dim para As Variant
 +
   
 +
    Dim periodFound As Boolean
 +
'    Dim openDoubleQuoteFound As Boolean    '發現第一個雙引號
 +
 +
    Dim charSaved As String
 
      
 
      
 
     Dim response As Integer
 
     Dim response As Integer
 +
    Dim cntLink As Integer
 +
    Dim i As Integer
 
      
 
      
−
     Set myDoc = ThisDocument
+
     Set myDoc = Documents("文件1")      '執行前，請確認中文文稿的 Word 檔名
 
     Set newDoc = Documents.Add
 
     Set newDoc = Documents.Add
 +
    cname = newDoc.Name
 
      
 
      
−
     For Each word In myDoc.Words
+
     cntLink = myDoc.Hyperlinks.Count
−
         newDoc.Content.InsertAfter Text:=word
+
   
−
'        response = MsgBox(word, vbOKCancel)
+
    For i = cntLink To 1 Step -1
−
'        If response = vbCancel Then Exit For
+
         myDoc.Hyperlinks(i).Range.Delete
 
     Next
 
     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)                        '分行符號
  
−
End Sub
+
                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
  
−
Sub testCopyByParagraphs()
+
            Case "」", "』", ")", Chr(41384)               '右引號
−
' 用 paragraph (段) 為單位複製文件，統計數字顯示完整抄錄
+
                If periodFound Then
−
    Dim myDoc As Document
+
                    newDoc.Content.InsertAfter Text:=charSaved
−
    Dim newDoc As Document
+
                    newDoc.Content.InsertAfter Text:=char & "</p>" & vbCrLf '& vbCrLf
−
   
+
                    newDoc.Content.InsertAfter Text:="<p class='chinese'>"
−
    Dim char As Variant
+
                    periodFound = False
−
    Dim word As Variant
+
                Else
−
   
+
                    newDoc.Content.InsertAfter Text:=char
−
    Dim para As Variant
+
                End If
−
   
+
            Case Else                                      '其它文字或符號
−
    Dim response As Integer
+
                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
 
      
 
      
−
    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
 
     Next
  
 
End Sub
 
End Sub
−
 
+
Sub convertEnglishToWiki()
−
Sub convertToWiki()
 
 
     Dim myDoc As Document
 
     Dim myDoc As Document
 
     Dim newDoc As Document
 
     Dim newDoc As Document
行 78： 行 138：
 
      
 
      
 
     Dim periodFound As Boolean
 
     Dim periodFound As Boolean
 +
 
     Dim charSaved As String
 
     Dim charSaved As String
 
      
 
      
 
     Dim response As Integer
 
     Dim response As Integer
 +
    Dim cntLink As Integer
 +
    Dim i As Integer
 
      
 
      
−
     Set myDoc = ThisDocument
+
     Set myDoc = Documents("文件1")      '執行前，請確認英文文稿的 Word 檔名
 
     Set newDoc = Documents.Add
 
     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 = ""
 
     charSaved = ""
 
     periodFound = False
 
     periodFound = False
−
     newDoc.Content.InsertAfter Text:="<p class='chinese'>"
+
     newDoc.Content.InsertAfter Text:="<p class='english'>"
 
      
 
      
 +
    i = 1
 
     For Each char In myDoc.Characters
 
     For Each char In myDoc.Characters
−
   
+
        Select Case char
−
   
+
            Case vbCr, vbLf, Chr(11)                        '分行符號
  
−
        Select Case char
+
                If periodFound Then
−
            Case vbCr, vbLf, Chr(11)
+
                    newDoc.Content.InsertAfter Text:=charSaved
−
            Case "。", ".", "！", "!", "？", "?", "；"
+
                    newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf
−
                 charSaved = char
+
                    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
 
                 periodFound = True
−
             Case "」", "』", ")"
+
 
 +
             Case ")", Chr(41384)               '右引號
 
                 If periodFound Then
 
                 If periodFound Then
 
                     newDoc.Content.InsertAfter Text:=charSaved
 
                     newDoc.Content.InsertAfter Text:=charSaved
−
                     newDoc.Content.InsertAfter Text:=char & "</p>" & vbCrLf & vbCrLf
+
                     newDoc.Content.InsertAfter Text:=char & "</p>" & vbCrLf '& vbCrLf
−
                     newDoc.Content.InsertAfter Text:="<p class='chinese'>"
+
                     newDoc.Content.InsertAfter Text:="<p class='english'>"
 
                     periodFound = False
 
                     periodFound = False
 +
                Else
 +
                    newDoc.Content.InsertAfter Text:=char
 
                 End If
 
                 End If
−
             Case Else
+
             Case Else                                       '其它文字或符號
 
                 If periodFound Then
 
                 If periodFound Then
 
                     newDoc.Content.InsertAfter Text:=charSaved
 
                     newDoc.Content.InsertAfter Text:=charSaved
−
                     newDoc.Content.InsertAfter Text:="</p>" & vbCrLf & vbCrLf
+
                     newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf
−
                     newDoc.Content.InsertAfter Text:="<p class='chinese'>"
+
                     newDoc.Content.InsertAfter Text:="<p class='english'>"
 
                     newDoc.Content.InsertAfter Text:=char
 
                     newDoc.Content.InsertAfter Text:=char
 
                     periodFound = False
 
                     periodFound = False
行 116： 行 211：
 
                 End If
 
                 End If
 
         End Select
 
         End Select
−
   
+
        i = i + 1
 
     Next
 
     Next
 +
  
 
End Sub
 
End Sub
 
</pre>
 
</pre>
−
 
−
 
−
 
−
[[Category:BYUMS]]
 

於 2018年5月1日 (二) 08:06 的最新修訂

英文斷字

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
取自 "http://www.limingyu2007.com/index.php?title=Word_VBA/利阿賀拿&oldid=8027"