VB code:
'------------------------
'Chinese character to PinYin abbreviations
'------------------------
Public Function getpysx (STR as string) as string
On Error goto proc_error
Dim I as long
For I = 0 to Len (STR)-1
Getpysx = getpysx & getpysxchar (mid (STR, I + 1, 1 ))
Next
Proc_error:
Exit Function
End Function
Public Function getpysxchar (char as string) as string
On Error goto proc_error
Dim lchar as long
Lchar = 65536 + ASC (char)
If (lchar & gt; = 45217 and lchar <= 45252) then
Getpysxchar = ""
Elseif (lchar> = 45253 and lchar <= 45760) then
Getpysxchar = "B"
Elseif (lchar> = 45761 and lchar <= 46317) then
Getpysxchar = "C"
Elseif (lchar> = 46318 and lchar <= 46825) then
Getpysxchar = "D"
Elseif (lchar> = 46826 and lchar <= 47009) then
Getpysxchar = "e"
Elseif (lchar> = 47010 and lchar <= 47296) then
Getpysxchar = "F"
Elseif (lchar> = 47297 and lchar <= 47613) then
Getpysxchar = "G"
Elseif (lchar> = 47614 and lchar <= 48118) then
Getpysxchar = "H"
Elseif (lchar> = 48119 and lchar <= 49061) then
Getpysxchar = "J"
Elseif (lchar> = 49062 and lchar <= 49323) then
Getpysxchar = "K"
Elseif (lchar> = 49324 and lchar <= 49895) then
Getpysxchar = "L"
Elseif (lchar> = 49896 and lchar <= 50370) then
Getpysxchar = "M"
Elseif (lchar> = 50371 and lchar <= 50613) then
Getpysxchar = "N"
Elseif (lchar> = 50614 and lchar <= 50621) then
Getpysxchar = "O"
Elseif (lchar> = 50622 and lchar <= 50905) then
Getpysxchar = "P"
Elseif (lchar> = 50906 and lchar <= 51386) then
Getpysxchar = "Q"
Elseif (lchar> = 51387 and lchar <= 51445) then
Getpysxchar = "R"
Elseif (lchar> = 51446 and lchar <= 52217) then
Getpysxchar = "S"
Elseif (lchar> = 52218 and lchar <= 52697) then
Getpysxchar = "T"
Elseif (lchar> = 52698 and lchar <= 52979) then
Getpysxchar = "W"
Elseif (lchar> = 52980 and lchar <= 53640) then
Getpysxchar = "X"
Elseif (lchar> = 53641 and lchar <= 54480) then
Getpysxchar = "Y"
Elseif (lchar> = 54481 and lchar <= 62289) then
Getpysxchar = "Z"
End if
Proc_error:
Exit Function
End Function