以下是测试模块
Sub 测试()
Dim str$
str = InputBox("请输入要识别的字符串")
MsgBox str & "的拼音首字母为:" & vbCr & vbCr & getPY(str)
End Sub
以下是功能实现模块
Function PinYin(str As String) As String
Select Case Asc(str)
Case -20319 To -20284: PinYin = "A"
Case -20283 To -19776: PinYin = "B"
Case -19775 To -19219: PinYin = "C"
Case -19218 To -18711: PinYin = "D"
Case -18710 To -18527: PinYin = "E"
Case -18526 To -18240: PinYin = "F"
Case -18239 To -17923: PinYin = "G"
Case -17922 To -17418: PinYin = "H"
Case -17417 To -16475: PinYin = "J"
Case -16474 To -16213: PinYin = "K"
Case -16212 To -15641: PinYin = "L"
Case -15640 To -15166: PinYin = "M"
Case -15165 To -14923: PinYin = "N"
Case -14922 To -14915: PinYin = "O"
Case -14914 To -14631: PinYin = "P"
Case -14630 To -14150: PinYin = "Q"
Case -14149 To -14091: PinYin = "R"
Case -14090 To -13319: PinYin = "S"
Case -13318 To -12839: PinYin = "T"
Case -12838 To -12557: PinYin = "W"
Case -12556 To -11848: PinYin = "X"
Case -11847 To -11056: PinYin = "Y"
Case -11055 To -2050: PinYin = "Z"
Case Else: PinYin = str
End Select
End Function
Function getPY(str)
Dim i%
For i = 1 To Len(str)
getPY = getPY & PinYin(Mid(str, i, 1))
Next i
End Function