"Word VBA/利阿賀拿" 修訂間的差異
出自 青少年追求卓越
< Word VBA
| 行 1： | 行 1： | ||
| − | = | + | __TOC__ |
| + | =英文斷字= | ||
<pre> | <pre> | ||
Option Explicit | Option Explicit | ||
| − | |||
| − | |||
| − | Sub | + | Public Sub extractWordFromDocument() |
| − | |||
Dim myDoc As Document | Dim myDoc As Document | ||
Dim newDoc As Document | Dim newDoc As Document | ||
| 行 14： | 行 12： | ||
Dim para As Variant | Dim para As Variant | ||
| − | Dim | + | Dim periodFound As Boolean |
| + | |||
| + | Dim charSaved As String | ||
| + | |||
| + | Dim lfON As Boolean | ||
| + | Dim cntLink As Integer | ||
| + | Dim i As Integer | ||
| − | Set myDoc = Documents("文件1") | + | Set myDoc = Documents("文件1") '執行前，請確認英文文稿的 Word 檔名 |
| − | + | Set newDoc = Documents.Add | |
| + | ename = newDoc.Name | ||
| − | For Each | + | |
| − | ' | + | cntLink = myDoc.Hyperlinks.Count |
| − | + | ||
| − | If | + | 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 | Next | ||
End Sub | End Sub | ||
| + | |||
| + | </pre> | ||
| + | =英中斷句= | ||
| + | <pre> | ||
| + | Option Explicit | ||
| + | Public cname As String | ||
| + | Public ename As String | ||
Sub convertChineseToWiki() | Sub convertChineseToWiki() | ||
Dim myDoc As Document | Dim myDoc As Document | ||
| 行 43： | 行 70： | ||
Dim i As Integer | Dim i As Integer | ||
| − | Set myDoc = | + | Set myDoc = Documents("文件1") '執行前，請確認中文文稿的 Word 檔名 |
Set newDoc = Documents.Add | Set newDoc = Documents.Add | ||
cname = newDoc.Name | cname = newDoc.Name | ||
| 行 69： | 行 96： | ||
newDoc.Content.InsertAfter Text:="<p class='chinese'>" | newDoc.Content.InsertAfter Text:="<p class='chinese'>" | ||
periodFound = False | periodFound = False | ||
| + | ' Else | ||
| + | ' newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf | ||
| + | ' newDoc.Content.InsertAfter Text:="<p class='chinese'>" | ||
End If | End If | ||
| − | Case "。", ".", "！", "!", "？", "?" | + | |
| + | Case "。", ".", "！", "!", "？", "?", "；", ";" ', "；"斷句符號 | ||
charSaved = char '斷句符號暫存 | charSaved = char '斷句符號暫存 | ||
periodFound = True | periodFound = True | ||
| 行 107： | 行 138： | ||
Dim periodFound As Boolean | Dim periodFound As Boolean | ||
| − | |||
Dim charSaved As String | Dim charSaved As String | ||
| 行 115： | 行 145： | ||
Dim i As Integer | Dim i As Integer | ||
| − | Set myDoc = | + | Set myDoc = Documents("文件1") '執行前，請確認英文文稿的 Word 檔名 |
Set newDoc = Documents.Add | Set newDoc = Documents.Add | ||
ename = newDoc.Name | ename = newDoc.Name | ||
| 行 132： | 行 162： | ||
i = 1 | i = 1 | ||
For Each char In myDoc.Characters | For Each char In myDoc.Characters | ||
| − | |||
Select Case char | Select Case char | ||
Case vbCr, vbLf, Chr(11) '分行符號 | Case vbCr, vbLf, Chr(11) '分行符號 | ||
| 行 141： | 行 170： | ||
newDoc.Content.InsertAfter Text:="<p class='english'>" | newDoc.Content.InsertAfter Text:="<p class='english'>" | ||
periodFound = False | periodFound = False | ||
| + | ' Else | ||
| + | ' newDoc.Content.InsertAfter Text:="</p>" & vbCrLf '& vbCrLf | ||
| + | ' newDoc.Content.InsertAfter Text:="<p class='english'>" | ||
End If | End If | ||
Case "." | Case "." | ||
| − | If | + | If (myDoc.Characters(i - 1) = ")" Or myDoc.Characters(i - 1) = Chr(41384)) Then '如果文章的第一個右括弧在第一個位置時，程式將無法執行，因為 i-1 超出範圍 |
| − | + | charSaved = char '斷句符號暫存 | |
| + | periodFound = True | ||
Else | Else | ||
| − | charSaved = char '斷句符號暫存 | + | 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 | End If | ||
| − | Case "!", "?" | + | |
| + | Case "!", "?", ";" '斷句符號 | ||
charSaved = char '斷句符號暫存 | charSaved = char '斷句符號暫存 | ||
periodFound = True | periodFound = True | ||
| 行 178： | 行 216： | ||
End Sub | End Sub | ||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
| − | |||
</pre> | </pre> | ||
| − | |||
| − | |||
| − | |||
| − | |||
於 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
![[license_name]](https://phab.wmfusercontent.org/file/data/74pabljogcsnddfc2fxw/PHID-FILE-drvxer3igopuuwy5clj7/cc-by-sa.png){kind=small}
