救命！帮助！help！如何得到一个汉字的第一个拼音字母？

Question

我想得到一个汉字的第一个拼音字母，比如， 爱 ，第一个字母就是 Z 
多谢了，！！！

Answer 1

Option Explicit'在窗口中加两个TEXT控件,一个输入中文,一个显示英文
Private Sub Form_Load()
    Text1.Text = "我是中国人"
End SubPrivate Sub Command1_Click()
    Text2.Text = GetPY(Text1.Text)
End Sub'获得输入名称的首字拼音
Private Function GetPY(ByVal strParmeter As String) As String
    Dim intTmp As String, i As Long
    
    For i = 1 To Len(strParmeter)
        intTmp = Asc(Mid(strParmeter, i, 1))        If intTmp < Asc("啊") Then
            GetPY = GetPY & "*"
        ElseIf intTmp >= Asc("啊") And intTmp < Asc("芭") Then
            GetPY = GetPY & "A"
        ElseIf intTmp >= Asc("芭") And intTmp < Asc("擦") Then
            GetPY = GetPY & "B"
        ElseIf intTmp >= Asc("擦") And intTmp < Asc("搭") Then
            GetPY = GetPY & "C"
        ElseIf intTmp >= Asc("搭") And intTmp < Asc("蛾") Then
            GetPY = GetPY & "D"
        ElseIf intTmp >= Asc("蛾") And intTmp < Asc("发") Then
            GetPY = GetPY & "E"
        ElseIf intTmp >= Asc("发") And intTmp < Asc("噶") Then
            GetPY = GetPY & "F"
        ElseIf intTmp >= Asc("噶") And intTmp < Asc("哈") Then
            GetPY = GetPY & "G"
        ElseIf intTmp >= Asc("哈") And intTmp < Asc("击") Then
            GetPY = GetPY & "H"
        ElseIf intTmp >= Asc("击") And intTmp < Asc("喀") Then
            GetPY = GetPY & "J"
        ElseIf intTmp >= Asc("喀") And intTmp < Asc("垃") Then
            GetPY = GetPY & "K"
        ElseIf intTmp >= Asc("垃") And intTmp < Asc("妈") Then
            GetPY = GetPY & "L"
        ElseIf intTmp >= Asc("妈") And intTmp < Asc("拿") Then
            GetPY = GetPY & "M"
        ElseIf intTmp >= Asc("拿") And intTmp < Asc("哦") Then
            GetPY = GetPY & "N"
        ElseIf intTmp >= Asc("哦") And intTmp < Asc("啪") Then
            GetPY = GetPY & "O"
        ElseIf intTmp >= Asc("啪") And intTmp < Asc("期") Then
            GetPY = GetPY & "P"
        ElseIf intTmp >= Asc("期") And intTmp < Asc("然") Then
            GetPY = GetPY & "Q"
        ElseIf intTmp >= Asc("然") And intTmp < Asc("撒") Then
            GetPY = GetPY & "R"
        ElseIf intTmp >= Asc("撒") And intTmp < Asc("塌") Then
            GetPY = GetPY & "S"
        ElseIf intTmp >= Asc("塌") And intTmp < Asc("挖") Then
            GetPY = GetPY & "T"
        ElseIf intTmp >= Asc("挖") And intTmp < Asc("昔") Then
            GetPY = GetPY & "W"
        ElseIf intTmp >= Asc("昔") And intTmp < Asc("压") Then
            GetPY = GetPY & "X"
        ElseIf intTmp >= Asc("压") And intTmp < Asc("匝") Then
            GetPY = GetPY & "Y"
        ElseIf intTmp >= Asc("匝") And intTmp < 0 Then
            GetPY = GetPY & "Z"
        ElseIf (intTmp >= 65 And intTmp <= 91) Or (intTmp >= 97 And intTmp <= 123) Then
            GetPY = GetPY & Mid(strParmeter, i, 1)
        Else
            GetPY = GetPY & "*"
        End If
    Next
End Function

Answer 2

http://expert.csdn.net/Expert/topic/2004/2004222.xml?temp=.0641138
查表法根据微软拼音输入法得到拼音的例子：
Option Explicit
Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmEscape Lib "imm32.dll" Alias "ImmEscapeA" (ByVal hkl As Long, ByVal himc As Long, ByVal un As Long, lpv As Any) As Long
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function IsDBCSLeadByte Lib "kernel32" (ByVal bTestChar As Byte) As Long
Public Function GetChineseSpell(Chinese As String, Optional Delimiter As String = " ", Optional IMEName As String = "微软拼音输入法", Optional BufferSize As Long = 255) As String
If VBA.Len(VBA.Trim(Chinese)) > 0 Then
 Dim i As Long
 Dim s As String
 s = VBA.Space(BufferSize)
 Dim IMEInstalled As Boolean
 Dim j As Long
 Dim a() As Long
 ReDim a(BufferSize) As Long
 j = GetKeyboardLayoutList(BufferSize, a(LBound(a)))
 
  
 For i = LBound(a) To LBound(a) + j - 1
   If ImmEscape(a(i), 0, IME_ESC_IME_NAME, ByVal s) Then
     If VBA.Trim(IMEName) = VBA.Replace(VBA.Trim(s), VBA.Chr(0), "") Then
      IMEInstalled = True
      Exit For
     End If
   End If
 Next i
 If IMEInstalled Then
   'Stop
   Chinese = VBA.Trim(Chinese)
   Dim sChar As String
   Dim Buffer0() As Byte
   'Dim Buffer() As Byte
   Dim bBuffer0() As Byte
   Dim bBuffer() As Byte
   Dim k As Long
   Dim l As Long
   Dim m As Long
   For j = 0 To VBA.Len(Chinese) - 1
   sChar = VBA.Mid(Chinese, j + 1, 1)
     Buffer0 = VBA.StrConv(sChar, vbFromUnicode)
     If IsDBCSLeadByte(Buffer0(0)) Then
      k = ImmEscape(a(i), 0, IME_ESC_MAX_KEY, Null)
      If k Then
        l = ImmGetConversionList(a(i), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
        If l Then
         s = VBA.Space(BufferSize)
         If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) Then
           
           bBuffer0 = VBA.StrConv(s, vbFromUnicode)
           ReDim bBuffer(k * 2 - 1)
           For m = bBuffer0(24) To bBuffer0(24) + k * 2 - 1
             bBuffer(m - bBuffer0(24)) = bBuffer0(m)
           Next m
           sChar = VBA.Trim(VBA.StrConv(bBuffer, vbUnicode))
           If VBA.InStr(sChar, vbNullChar) Then
            sChar = VBA.Trim(VBA.Left(sChar, VBA.InStr(sChar, vbNullChar) - 1))
           End If
           sChar = VBA.Left(sChar, VBA.Len(sChar) - 1) & VBA.IIf(j < VBA.Len(Chinese) - 1, Delimiter, "")
           
         End If
         
        End If
      End If
     End If
     GetChineseSpell = GetChineseSpell & sChar
   Next j
 Else
   
 
 End If
  
End If
End FunctionPrivate Sub Command1_Click()
VBA.MsgBox GetChineseSpell("你好")
End Sub

Answer 3

如果是数据库中的处理,可以参考SQL数据库对拼音的处理:http://expert.csdn.net/Expert/topic/2361/2361465.xml?temp=.5148279

Answer 4

cuizm(射天狼)的回答不错，以前我的做法是做一个数据库（利用UCDOS里的编码）。

Answer 5

to: cuizm(射天狼)你的拼音处理有些问题.我以前看过类似的,都存在这样的问题:debug.print getpy("东莞市禅城区")
结果为:
DZSZCQ显示是不对的.