有没有通过汉字确定该字拼音首字母的函数?

Public Function PY(Tstr As String) As String
Dim a, N, i As Long
Dim b, d, PinYin As String

a = Len(Tstr)
For N = 1 To a
    b = Mid(Tstr, N, 1)
'    Debug.Print B
    i = Asc(b)

'I = Asc(Tstr)

If i >= Asc("啊") And i < Asc("芭") Then PinYin = "a"

If i >= Asc("芭") And i < Asc("擦") Then PinYin = "b"

If i >= Asc("擦") And i < Asc("搭") Then PinYin = "c"

If i >= Asc("搭") And i < Asc("蛾") Then PinYin = "d"

If i >= Asc("蛾") And i < Asc("发") Then PinYin = "e"

If i >= Asc("发") And i < Asc("噶") Then PinYin = "f"

If i >= Asc("噶") And i < Asc("哈") Then PinYin = "g"

If i >= Asc("哈") And i < Asc("击") Then PinYin = "h"

If i >= Asc("击") And i < Asc("喀") Then PinYin = "j"

If i >= Asc("喀") And i < Asc("垃") Then PinYin = "k"

If i >= Asc("垃") And i < Asc("妈") Then PinYin = "l"

If i >= Asc("妈") And i < Asc("拿") Then PinYin = "m"

If i >= Asc("拿") And i < Asc("哦") Then PinYin = "n"

If i >= Asc("哦") And i < Asc("啪") Then PinYin = "o"

If i >= Asc("啪") And i < Asc("欺") Then PinYin = "p"

If i >= Asc("欺") And i < Asc("然") Then PinYin = "q"

If i >= Asc("然") And i < Asc("撒") Then PinYin = "r"

If i >= Asc("撒") And i < Asc("塌") Then PinYin = "s"

If i >= Asc("塌") And i < Asc("挖") Then PinYin = "t"

If i >= Asc("挖") And i < Asc("昔") Then PinYin = "w"

If i >= Asc("昔") And i < Asc("压") Then PinYin = "x"

If i >= Asc("压") And i < Asc("匝") Then PinYin = "y"

If i >= Asc("匝") And i <= Asc("座") Then PinYin = "z"

d = d & PinYin
Next N
'Debug.Print D
PY = d
End Function