Sub ConvertSymbol(strFontName As String)
Dim dlg As Object
Dim NoFC As Integer
Dim SCP As Integer
Dim StartRange As Range
Dim UniCodeNum As Integer
Dim uArray As Variant
Dim ufile, ucode
Dim ti, tloop, tv1, tv2, tchr1, tchr2, tadd, tindex, tcount
Dim tstring As String, ustring As Variant, uchar As Variant
'
Set ufile = CreateObject("Scripting.FileSystemObject")
Set ucode = ufile.OpenTextFile("C:\Unicode\big5u2.txt", 1, 0, -1)
uArray = ucode.ReadAll
' Temporarily disable Screen Updating
Application.ScreenUpdating = False
' Temporarily disable Smart Cut & Paste
If Options.SmartCutPaste = True Then
SCP = 1
Options.SmartCutPaste = False
End If
' Temporarily display field text
If ActiveWindow.View.ShowFieldCodes = False Then
NoFC = 1
ActiveWindow.View.ShowFieldCodes = True
End If
' Add a loop to march through the text looking for Chn FKai M5
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
' the font name can be changed to whatever you need: just
' make it exact
.Font.Name = strFontName ' "Chn FKai M5"
.MatchCase = False
.MatchWholeWord = False
' this line below can be commented out
.MatchByte = False
' this line below can be commented out
.MatchAllWordForms = False
' this line below can be commented out
.MatchSoundsLike = False
' this line below can be commented out
.MatchWildcards = False
' this line below can be commented out
.MatchFuzzy = False
End With
tcount = 0
While Selection.Find.Execute() = True 'And tcount < 100
' increment the loop counter
tcount = tcount + 1
' Reset the unicode string
ustring = ""
' Set StartRange variable to current selection's range
Set StartRange = Selection.Range
Selection.Collapse
' Select first, then each next character in user-defined selection
Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
If Selection.End = ActiveDocument.Content.End Then
Selection.Font.Name = "SimSun"
GoTo Skipme
End If
While Selection.End <= StartRange.End And _
ActiveDocument.Content.End > Selection.End
' If the character is a space, then move to next character
Set dlg = Dialogs(wdDialogInsertSymbol)
UniCodeNum = dlg.charnum
If UniCodeNum = 32 Or UniCodeNum = 13 Or UniCodeNum = 12 Then
Selection.Font.Name = "SimSun"
Selection.Collapse
Selection.MoveRight Unit:=wdCharacter, Extend:=wdMove
Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
End If
' Loop, converting symbol Unicode characters to ASCII characters
tloop = 0
Set dlg = Dialogs(wdDialogInsertSymbol)
UniCodeNum = dlg.charnum
While UniCodeNum < 0 And Selection.End <= StartRange.End _
And ActiveDocument.Content.End > Selection.End
' test whether this is first loop or second
If tloop = 0 Then
tv1 = UniCodeNum + 4096
tchr1 = ChrW(tv1)
uchar = tchr1
If tv1 < 160 Then
Selection.Font.Name = "SimSun"
Selection.TypeText (uchar)
'Selection.InsertAfter (uchar)
Else
Selection.Delete
tloop = 1
End If
Selection.Collapse (wdCollapseEnd)
Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
Set dlg = Dialogs(wdDialogInsertSymbol)
UniCodeNum = dlg.charnum
Else
tv2 = UniCodeNum + 4096
tchr2 = ChrW(tv2)
If tv1 > 249 Then
uchar = tchr1 + tchr2
Else
If tv2 < 128 Then
tadd = tv2 - 64
Else
tadd = tv2 - 96
End If
If tv1 < 164 Then
tindex = 160 * (tv1 - 161) + tadd + 1
Else
tindex = 160 * (tv1 - 164) + 417 + tadd + 1
End If
uchar = Mid(uArray, tindex, 1)
End If
tloop = 0
Selection.Font.Name = "SimSun"
Selection.TypeText (uchar)
Selection.Collapse (wdCollapseEnd)
Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
Set dlg = Dialogs(wdDialogInsertSymbol)
UniCodeNum = dlg.charnum
End If
Wend
Selection.Collapse (wdCollapseEnd)
Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
Wend
' Reset Word document settings
Selection.Collapse (wdCollapseEnd)
Selection.MoveLeft Unit:=wdCharacter
Skipme:
s = 1
Wend
If SCP = 1 Then Options.SmartCutPaste = True
If NoFC = 1 Then ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ucode.Close
End Sub
Sunday, January 17, 2010
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment