|
4Dyi9Vox.rar
(7.94 KB, 下载次数: 23)
以下代码供网友们参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By 守柔(ShouRou)@ExcelHome 2005-1-21 6:02:24
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Function Getpychar(char)
Dim Tmp As Long
Tmp = 65536 + Asc(char)
Select Case Tmp
Case 45217 To 45252
Getpychar = "a"
Case 45253 To 45760
Getpychar = "b"
Case 45761 To 46317
Getpychar = "c"
Case 46318 To 46825
Getpychar = "d"
Case 46826 To 47009
Getpychar = "e"
Case 47010 To 47296
Getpychar = "f"
Case 47297 To 47613
Getpychar = "g"
Case 47614 To 48118
Getpychar = "h"
Case 48119 To 49061
Getpychar = "j"
Case 49062 To 49323
Getpychar = "k"
Case 49324 To 49895
Getpychar = "l"
Case 49896 To 50370
Getpychar = "m"
Case 50371 To 50613
Getpychar = "n"
Case 50614 To 50621
Getpychar = "o"
Case 50622 To 50905
Getpychar = "p"
Case 50906 To 51386
Getpychar = "q"
Case 51387 To 51445
Getpychar = "r"
Case 51446 To 52217
Getpychar = "s"
Case 52218 To 52697
Getpychar = "t"
Case 52698 To 52979
Getpychar = "w"
Case 52980 To 53640
Getpychar = "x"
Case 53689 To 54480
Getpychar = "y"
Case 54481 To 62289
Getpychar = "z"
Case Else
'如果不是中文，则返加原字符
Getpychar = char
End Select
End Function
'----------------------
Sub GetPYText()
Dim i As Range, GetPY As String
If Selection.Type = wdSelectionIP Then '未选文本,光标状态
MsgBox "请选定文本!", vbOKOnly + vbExclamation, " Word Warning!"
Else
For Each i In Selection.Characters
GetPY = GetPY & Getpychar(i)
Next
MsgBox GetPY
End If
End Sub
'---------------------- | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-1-20 21:57
