Dim CNT As New ADODB.Connection
Sub 檢查可能未標點者()
Dim rst As New ADODB.Recordset, d As Document, r As Range, x As String, e As Long
Dim rstPass As New ADODB.Recordset
Const dbF As String = "C:\@@@華語文工具及資料@@@\Macros\說文資料庫原造字取代為系統字參照用.mdb"
If CNT.State = 0 Then CNT.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & dbF
Set d = ActiveDocument
Set r = d.Range
'rst.Open "select * from 《易》學書標書名號 where (組別=1 or 組別=7 or 組別=8 or 組別=9 or 先後順序 =10000 or 先後順序 =99999) order by 組別,先後順序,ID", cnt '要取代哪一組格式的文字
'rst.Open "《易》學書標書名號", CNT, adOpenKeyset, adLockReadOnly
rst.Open "select * from 《易》學書標書名號 where 組別<>64 and 組別<>2 and 組別<>3 and 組別<>4", CNT, adOpenKeyset, adLockReadOnly
With rst
Do Until .EOF
x = .Fields("須標書名號字詞").Value
If InStr(d.Range, x) > 0 Then
rstPass.Open "select 略過不標書名號,字長 from 《易》學書標書名號_略過不標者 where instr(略過不標書名號,""" & x & """)>0", CNT, adOpenKeyset, adLockOptimistic
Set r = d.Range
r.Find.ClearAllFuzzyOptions: r.Find.ClearFormatting
Do While r.Find.Execute(x, , , , , , True, wdFindStop)
If (r.Previous <> "《" And r.Previous <> "·" And r.Previous <> "‧") And (r.Next <> "·" And r.Next <> "》" And r.Next <> "‧") And r.HighlightColorIndex = 0 Then
e = r.End
' r.Select
' Stop
If Not 比對略過不標書名號(rstPass, r) Then
r.SetRange e - Len(x), e
r.Select: Beep
Stop
If Selection.Type <> wdSelectionIP And VBA.Len(Selection.Text) > VBA.Len(x) Then 略過不標書名號 rstPass, Selection.Range
End If
'If rstPass.RecordCount > 0 Then rstPass.MoveFirst
r.SetRange e, d.Range.End
End If
Loop
rstPass.Close
End If
.MoveNext
Loop
End With
MsgBox "done!", vbInformation
End Sub
Function 比對略過不標書名號(rst As ADODB.Recordset, xR As Range) As Boolean
Dim r As Range, l As Byte, i As Integer, ps As Long
Set r = xR: ps = xR.End
With rst
If rst.RecordCount > 0 Then
Do Until .EOF
l = Len(.Fields("略過不標書名號").Value) '擴充漢字，End屬性一樣是算二個長度
For i = -l To l
r.SetRange ps + i, ps + i + l
If StrComp(r.Text, .Fields("略過不標書名號").Value) = 0 Then
比對略過不標書名號 = True
.MoveFirst
Exit Function
End If
Next i
.MoveNext
Loop
.MoveFirst
End If
End With
End Function
Sub 略過不標書名號(rst As ADODB.Recordset, xSelection As Range)
Dim rstp As New ADODB.Recordset
rstp.Open "select 略過不標書名號 from 《易》學書標書名號_略過不標者 where strcomp(略過不標書名號,""" & xSelection & """)=0", CNT, adOpenKeyset, adLockReadOnly
If rstp.RecordCount = 0 Then
With rst
.AddNew
.Fields("略過不標書名號").Value = xSelection
.Fields("字長").Value = xSelection.Characters.Count
.Update
.Requery
End With
End If
rstp.Close
End Sub
留言