问个汉字转换成拼音首写的问题

Question

如（网站），输入后自动生成WZ,以及比如网站2字，输入后自动生成字符数2个，希望高手指教，在线等

Answer 1

Option ExplicitPrivate Function pinyin(ByVal x As String) As String
    Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
    If x = "座" Then pinyin = "Z"
    For I = 1 To 23
        If Asc(x) >= Asc(Mid(hanzi, I, 1)) And Asc(x) < Asc(Mid(hanzi, I + 1, 1)) Then pinyin = Mid(hanzi, 24 + I, 1)
    Next
End Function'*******************************************Public Function GetTextFirstLetter(strText As String) As String
'求出一字串的全部首字母
Dim t As Integer
Dim strTempLetters As String
For t = 1 To Len(strText)
    strTempLetters = strTempLetters + GetCharFirstLetter(Asc(Mid(strText, t, 1)))
Next
GetTextFirstLetter = strTempLetters
End FunctionPrivate Function GetCharFirstLetter(intChar As Integer) As String
'求出单个汉字的首字母，内部调用
'输入汉字asc码，输出首字母
Select Case intChar
Case Is >= 0:          GetCharFirstLetter = Chr(intChar)
Case Is >= -10246:     GetCharFirstLetter = " "
Case Is >= -11055:     GetCharFirstLetter = "Z"
Case Is >= -11847:     GetCharFirstLetter = "Y"
Case Is >= -12556:     GetCharFirstLetter = "X"
Case Is >= -12838:     GetCharFirstLetter = "W"
Case Is >= -13318:     GetCharFirstLetter = "T"
Case Is >= -14090:     GetCharFirstLetter = "S"
Case Is >= -14149:     GetCharFirstLetter = "R"
Case Is >= -14630:     GetCharFirstLetter = "Q"
Case Is >= -14914:     GetCharFirstLetter = "P"
Case Is >= -14922:     GetCharFirstLetter = "O"
Case Is >= -15165:     GetCharFirstLetter = "N"
Case Is >= -15640:     GetCharFirstLetter = "M"
Case Is >= -16212:     GetCharFirstLetter = "L"
Case Is >= -16474:     GetCharFirstLetter = "K"
Case Is >= -17417:     GetCharFirstLetter = "J"
Case Is >= -17922:     GetCharFirstLetter = "H"
Case Is >= -18239:     GetCharFirstLetter = "G"
Case Is >= -18526:     GetCharFirstLetter = "F"
Case Is >= -18710:     GetCharFirstLetter = "E"
Case Is >= -19218:     GetCharFirstLetter = "D"
Case Is >= -19775:     GetCharFirstLetter = "C"
Case Is >= -20283:     GetCharFirstLetter = "B"
Case Is >= -20319:     GetCharFirstLetter = "A"
Case Else:             GetCharFirstLetter = " "
End Select
End Function'*************************************************
Public Function ChinesePronounce(ByVal Chinese As String, Optional Lower As Boolean = False) As String
'将汉字转换拼音首字母
On Error GoTo er
 Dim hz As String
 Dim MyHzm As Integer
 Dim Qm As Integer
 Dim Wm As Integer
 Dim HzNm As String
 Dim I As Integer
 Dim TmpStr As String
 hz = Chinese
For I = 1 To Len(hz)
    TmpStr = Mid(hz, I, 1)
    MyHzm = Asc(TmpStr)
    If MyHzm >= 0 And MyHzm < 256 Then
        If MyHzm = 32 Then GoTo er
        If Lower Then ChinesePronounce = ChinesePronounce + LCase(TmpStr) Else ChinesePronounce = ChinesePronounce + UCase(TmpStr):        GoTo er
    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
        If Lower Then ChinesePronounce = ChinesePronounce + "a" Else ChinesePronounce = ChinesePronounce + "A"
    ElseIf "B0C5" <= HzNm And HzNm <= "B2C0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "b" Else ChinesePronounce = ChinesePronounce + "B"
    ElseIf "B2C1" <= HzNm And HzNm <= "B4ED" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "c" Else ChinesePronounce = ChinesePronounce + "C"
    ElseIf "B4EE" <= HzNm And HzNm <= "B6E9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "d" Else ChinesePronounce = ChinesePronounce + "D"
    ElseIf "B6EA" <= HzNm And HzNm <= "B7A1" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "e" Else ChinesePronounce = ChinesePronounce + "E"
    ElseIf "B7A2" <= HzNm And HzNm <= "B8C0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "f" Else ChinesePronounce = ChinesePronounce + "F"
    ElseIf "B8C1" <= HzNm And HzNm <= "B9FD" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "g" Else ChinesePronounce = ChinesePronounce + "G"
    ElseIf "B9FE" <= HzNm And HzNm <= "BBF6" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "h" Else ChinesePronounce = ChinesePronounce + "H"
    ElseIf "BBF7" <= HzNm And HzNm <= "BFA5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "j" Else ChinesePronounce = ChinesePronounce + "J"
    ElseIf "BFA6" <= HzNm And HzNm <= "C0AB" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "k" Else ChinesePronounce = ChinesePronounce + "K"
    ElseIf "C0AC" <= HzNm And HzNm <= "C2E7" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "l" Else ChinesePronounce = ChinesePronounce + "L"
    ElseIf "C2E8" <= HzNm And HzNm <= "C4C2" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "m" Else ChinesePronounce = ChinesePronounce + "M"
    ElseIf "C4C3" <= HzNm And HzNm <= "C5B5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "n" Else ChinesePronounce = ChinesePronounce + "N"
    ElseIf "C5B6" <= HzNm And HzNm <= "C5BD" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "o" Else ChinesePronounce = ChinesePronounce + "O"
    ElseIf "C5BE" <= HzNm And HzNm <= "C6D9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "p" Else ChinesePronounce = ChinesePronounce + "P"
    ElseIf "C6DA" <= HzNm And HzNm <= "C8BA" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "q" Else ChinesePronounce = ChinesePronounce + "Q"
    ElseIf "C8BB" <= HzNm And HzNm <= "C8F5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "r" Else ChinesePronounce = ChinesePronounce + "R"
    ElseIf "C8F6" <= HzNm And HzNm <= "CBF9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "s" Else ChinesePronounce = ChinesePronounce + "S"
    ElseIf "CBFA" <= HzNm And HzNm <= "CDD9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "t" Else ChinesePronounce = ChinesePronounce + "T"
    ElseIf "CDDA" <= HzNm And HzNm <= "CEF3" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "w" Else ChinesePronounce = ChinesePronounce + "W"
    ElseIf "CEF4" <= HzNm And HzNm <= "D188" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "x" Else ChinesePronounce = ChinesePronounce + "X"
    ElseIf "D1B9" <= HzNm And HzNm <= "D4D0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "y" Else ChinesePronounce = ChinesePronounce + "Y"
    ElseIf "D4D1" <= HzNm And HzNm <= "D7F9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "z" Else ChinesePronounce = ChinesePronounce + "Z"
    Else
        ChinesePronounce = ChinesePronounce + HzNm
    End If
Next
er:
If Err.Number <> 0 Then ChinesePronounce = vbNullChar
End FunctionPrivate 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
Private Sub myDivide(num1 As Integer, num2 As Integer, Q As Integer, R As Integer)
If num2 = 0 Then Exit Sub
If num1 / num2 >= 0 Then
    Q = Int(num1 / num2)
Else
    Q = Int(num1 / num2) + 1
End If
R = num1 Mod num2
End Sub

Answer 2

用法：?GetTextFirstLetter("网站")
WZ