VB代码：
'------------------------
'汉字转拼音缩写
'------------------------
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 >= 45217 And lChar <= 45252) Then
GetPYSXChar = "A"
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