获取汉字的拼音首字母

 Option Explicit

Private Function GetPY(strHZ As String) As String '获得单个汉字拼音的首字符
    strHZ = Hex(Asc(strHZ))    '将汉字转换为其内码的十六进制字符串
    Select Case strHZ
    Case "B0A1" To "B0C4"
        GetPY = "a"
    Case "B0C5" To "B2C0"
        GetPY = "b"
    Case "B2C1" To "B4ED"
        GetPY = "c"
    Case "B4EE" To "B6E9"
      GetPY = "d"
    Case "B6EA" To "B7A1"
        GetPY = "e"
    Case "B7A2" To "B8C0"
        GetPY = "f"
    Case "B8C1" To "B9FD"
        GetPY = "g"
    Case "B9FE" To "BBF6"
        GetPY = "h"
    Case "BBF7" To "BFA5"
        GetPY = "j"
    Case "BFA6" To "C0AB"
        GetPY = "k"
    Case "C0AC" To "C2E7"
        GetPY = "l"
    Case "C2E8" To "C4C2"
        GetPY = "m"
    Case "C4C3" To "C5B5"
        GetPY = "n"
    Case "C5B6" To "C5BD"
        GetPY = "o"
    Case "C5BE" To "C6D9"
        GetPY = "p"
    Case "C6DA" To "C8BA"
        GetPY = "q"
    Case "C8BB" To "C8F5"
        GetPY = "r"
    Case "C8F6" To "CBF9"
        GetPY = "s"
    Case "CBFA" To "CDD9"
        GetPY = "t"
    Case "CDDA" To "CEF3"
        GetPY = "w"
    Case "CEF4" To "D188"
        GetPY = "x"
    Case "D189" To "D4D0"
        GetPY = "y"
    Case "D4D1" To "D7F9"
        GetPY = "z"
    Case Else
        GetPY = " "
    End Select
End Function

Public Function GetCode(strZF) As String  '将汉字字符串转换为其拼音的首字符串
    If strZF = "" Then Exit Function
    Dim I As Integer, S As String
    For I = 1 To Len(strZF)
        S = Mid(strZF, I, 1)
        GetCode = GetCode & UCase(GetPY(S))
    Next I
End Function