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