原创 (VB自定义函数)对任意输入的汉字，可以得到它的拼音的第一个字母

调用方法：Command1.Caption = getHzPy("你")

'//函数入口为汉字串，返回值为该汉字的第一个字母
Public Function getHzPy(hzStr As String) As String
On Error Resume Next
'declare  variable
Dim myHzm As Integer
Dim qm As Integer
Dim wm As Integer
Dim hznm As String
If Len(hzStr) > 1 Then
    myHzm = Asc(Left(hzStr, 1))
Else
    myHzm = Asc(hzStr)
End If
If myHzm >= 0 And myHzm < 256 Then
    '字母
    getHzPy = hzStr
Else
    '汉字
    qm = (myHzm + 65536) \ 256    '取区码
    wm = (myHzm + 65536) Mod 256  '取位码
    '十进制到十六进制
    hznm = tento(qm, 16) & tento(wm, 16)
End If
If "B0A1" <= hznm And hznm <= "B0C4" Then
getHzPy = "A"
ElseIf "B0C5" <= hznm And hznm <= "B2C0" Then
getHzPy = "B"
ElseIf "B2C1" <= hznm And hznm <= "B4ED" Then
getHzPy = "C"
ElseIf "B4EE" <= hznm And hznm <= "B6E9" Then
getHzPy = "D"
ElseIf "B6EA" <= hznm And hznm <= "B7A1" Then
getHzPy = "E"
ElseIf "B7A2" <= hznm And hznm <= "B8C0" Then
getHzPy = "F"
ElseIf "B8C1" <= hznm And hznm <= "B9FD" Then
getHzPy = "G"
ElseIf "B9FE" <= hznm And hznm <= "BBF6" Then
getHzPy = "H"
ElseIf "BBF7" <= hznm And hznm <= "BFA5" Then
getHzPy = "J"
ElseIf "BFA6" <= hznm And hznm <= "C0AB" Then
getHzPy = "K"
ElseIf "C0AC" <= hznm And hznm <= "C2E7" Then
getHzPy = "L"
ElseIf "C2E8" <= hznm And hznm <= "C4C2" Then
getHzPy = "M"
ElseIf "C4C3" <= hznm And hznm <= "C5B5" Then
getHzPy = "N"
ElseIf "C5B6" <= hznm And hznm <= "C5BD" Then
getHzPy = "O"
ElseIf "C5BE" <= hznm And hznm <= "C6D9" Then
getHzPy = "P"
ElseIf "C6DA" <= hznm And hznm <= "C8BA" Then
getHzPy = "Q"
ElseIf "C8BB" <= hznm And hznm <= "C8F5" Then
getHzPy = "R"
ElseIf "C8F6" <= hznm And hznm <= "CBF9" Then
getHzPy = "S"
ElseIf "CBFA" <= hznm And hznm <= "CDD9" Then
getHzPy = "T"
ElseIf "CDDA" <= hznm And hznm <= "CEF3" Then
getHzPy = "W"
ElseIf "CEF4" <= hznm And hznm <= "D188" Then
getHzPy = "X"
ElseIf "D1B9" <= hznm And hznm <= "D4D0" Then
getHzPy = "Y"
ElseIf "D4D1" <= hznm And hznm <= "D7F9" Then
getHzPy = "Z"
Else
getHzPy = hznm
End If
End Function
'************************辅助函数，可以从十进制转换到任意进制**********************
'//入口为十进制数，要转换的进制，返回为该进制数
Public Function tento(m As Integer, n As Integer) As String
Dim q As Integer
Dim r As Integer
    tento = ""
    Dim bStr As String
    Do
    Call myDivide(m, n, q, r)
    If r > 9 Then
        bStr = Chr(55 + r)
    Else
        bStr = Str(r)
    End If
    tento = Trim(bStr) & tento
    m = q
    Loop While q <> 0
End Function

'************************辅助过程，得到任意两个数的商和余数***************************
Public Sub myDivide(num1 As Integer, num2 As Integer, q As Integer, r As Integer)
    If num2 = 0 Then
        MsgBox ("非法除数")
        Exit Sub
    End If
    If num1 / num2 >= 0 Then
        q = Int(num1 / num2)
    Else
        q = Int(num1 / num2) + 1
    End If
        r = num1 Mod num2
End Sub

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/daedalboy/archive/2006/11/19/1396812.aspx