求一取得汉字拼音缩写的函数!

忆君发的
http://club.5ivb.net/dispbbs.asp?BoardID=124&Page=1&id=45978&replyID=45978&star=2&skin= '对应字母顺序"A B C D E F G H IJ K L M N O P Q R S T UVW X Y Z
'对于I，U，V这三个字母的相应位置用一个空格(半角)vbKeySpace代替
Private Const CC = "芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌  挖昔压匝"
'函数功能：
'  将汉字(串)转换成该汉字的汉语拼音第一个字母的大写(串)
'作用范围：
'  全局(Public)
'返回值：
'  返回所传递(字串的第一个)字符(串)的汉语拼音的第一个字母的大写(串)
'参数说明：
'  ChineseCharacter(String)：所要转换的(汉字、字串)字符(串)
Function ChangeToBopomofo(ByVal ChineseString As String) As String
Dim intLength As Integer   '传递字符(串)串长
Dim intLoop As Integer     '循环变量
Dim strBopomofo As String  '字符(串)中每一个汉字的拼音的第一个字母的大写临时变量
intLength = Len(ChineseString)   '取串长
strBopomofo = vbNullString       '预置临时变量
'获取字符(串)的拼音
For intLoop = 1 To intLength     '开始循环
   '依次取得每一个(汉字)字符的拼音首字母
   '调用GetBopomofo取得
   strBopomofo = strBopomofo & GetBopomofo(Mid(ChineseString, intLoop, 1))
Next intLoop
ChangeToBopomofo = strBopomofo   '返回值
End Function
'函数功能：
'  将汉字转换成该汉字的汉语拼音第一个字母的大写
'作用范围：
'  私有(Private)
'返回值：
'  返回所传递(字串的第一个)字符的汉语拼音的第一个字母的大写
'参数说明：
'  ChineseCharacter(String)：所要转换的(汉字、字串)字符
Private Function GetBopomofo(ByVal ChineseCharacter As String) As String
'声明变量
Dim intFirstAscii As Long     '第一个字符的ASCII
Dim intTempAscii As Long      '汉字集CC的字符ASCII
Dim intLoop As Long           '循环变量
Dim strBopomofo As String     '最后要返回的拼音字母
If ChineseCharacter = vbNullString Then   '判断要转换的字符是否为空串
   strBopomofo = vbNullString '为空串，返回空串
Else                                      '要转换的字符不为空串
   '取要转换的(汉字)字符(串)第一个字符的ASCII
   intFirstAscii = Asc(Left(ChineseCharacter, 1))
   '判断是否为汉字(UNICODE字符),！！！注意判断条件！！！
   If LenB(StrConv(Chr(intFirstAscii), vbFromUnicode)) = 2 Then
      '为汉字,去找相应的字母
      Select Case intFirstAscii
         Case -7970 '噢(o)
            strBopomofo = "O"
         Case -5955 '杞(qi)
            strBopomofo = "Q"
         Case -7983 '嘌(piao)
            strBopomofo = "P"
         Case -8364 '呤(ling)
            strBopomofo = "L"
         Case Else
            '开始查找该要转换的字符在汉字集CC的哪个位置,从而找到对应位置的字母
            '循环退出时,intLoop返回对应的字母位置
            For intLoop = 1 To Len(CC)
               '取汉字集中的汉字的ASCII，以备进行比较
               intTempAscii = Asc(Mid(CC, intLoop, 1))
               '查找条件
               If intFirstAscii < intTempAscii And intTempAscii <> vbKeySpace Then
                  Exit For
               End If
            Next intLoop
            '获取大写字母
            strBopomofo = Chr(vbKeyA + intLoop - 1)
            '判断大写字母是否是I,U或V
            If strBopomofo = "I" Then strBopomofo = "H"
            If strBopomofo = "U" Or strBopomofo = "V" Then strBopomofo = "T"
      End Select
   Else
      '获取不是汉字的其他字符的大写字母
      strBopomofo = UCase(Chr(intFirstAscii))
   End If
End If
GetBopomofo = strBopomofo '函数返回
End Function

/*-1.-获得汉字字符串的首字母   根据大力的贴子改成.将大力的两个函数合并成了一个函数.
在邹建的整理中发现
   可以应用于助记码的查询
--转载(最早见于j9988的发表,具体原作者不明)--*/
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[fGetPy]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[fGetPy]
GO--创建取拼音函数
create function fGetPy(@Str varchar(500)='')
returns varchar(500)
as
begin
declare @strlen int,@return varchar(500),@ii int
declare @n int,@c char(1),@chn nchar(1) select @strlen=len(@str),@return='',@ii=0
set @ii=0
while @ii<@strlen
begin
  select @ii=@ii+1,@n=63,@chn=substring(@str,@ii,1)
  if @chn>'z'
  select @n = @n +1
     ,@c = case chn when @chn then char(@n) else @c end
   from(
    select top 27 * from (
     select chn = '吖'
     union all select '八'
     union all select '嚓'
     union all select '咑'
     union all select '妸'
     union all select '发'
     union all select '旮'
     union all select '铪'
     union all select '丌'  --because have no 'i'
     union all select '丌'
     union all select '咔'
     union all select '垃'
     union all select '嘸'
     union all select '拏'
     union all select '噢'
     union all select '妑'
     union all select '七'
     union all select '呥'
     union all select '仨'
     union all select '他'
     union all select '屲'  --no 'u'
     union all select '屲'  --no 'v'
     union all select '屲'
     union all select '夕'
     union all select '丫'
     union all select '帀'
     union all select @chn) as a
    order by chn COLLATE Chinese_PRC_CI_AS
   ) as b
  else set @c='a'
  set @return=@return+@c
end
return(@return)
endgo
--测试
select dbo.fgetpy('东莞市') as 东莞市,dbo.fgetpy('我喜欢你去吃大便') as 中国人--删除拼音函数
drop function fgetpy

'转换拼音
Public Function GetPyChar(char As String) As String

   On Error Resume Next

   Dim Tmp As Long
    Tmp = 65536 + Asc(char)
    If Tmp = 53687 Then
       GetPyChar = "s"
       Exit Function
    End If
    If (Tmp >= 45217 And Tmp <= 45252) Then
       GetPyChar = "a"
    ElseIf (Tmp >= 45253 And Tmp <= 45760) Then
       GetPyChar = "b"
    ElseIf (Tmp >= 45761 And Tmp <= 46317) Then
       GetPyChar = "c"
    ElseIf (Tmp >= 46318 And Tmp <= 46825) Then
       GetPyChar = "d"
    ElseIf (Tmp >= 46826 And Tmp <= 47009) Then
       GetPyChar = "e"
    ElseIf (Tmp >= 47010 And Tmp <= 47296) Then
       GetPyChar = "f"
    ElseIf (Tmp >= 47297 And Tmp <= 47613) Then
       GetPyChar = "g"
    ElseIf (Tmp >= 47614 And Tmp <= 48118) Then
       GetPyChar = "h"
    ElseIf (Tmp >= 48119 And Tmp <= 49061) Then
       GetPyChar = "j"
    ElseIf (Tmp >= 49062 And Tmp <= 49323) Then
       GetPyChar = "k"
    ElseIf (Tmp >= 49324 And Tmp <= 49895) Then
       GetPyChar = "l"
    ElseIf (Tmp >= 49896 And Tmp <= 50370) Then
       GetPyChar = "m"
    ElseIf (Tmp >= 50371 And Tmp <= 50613) Then
       GetPyChar = "n"
    ElseIf (Tmp >= 50614 And Tmp <= 50621) Then
       GetPyChar = "o"
    ElseIf (Tmp >= 50622 And Tmp <= 50905) Then
       GetPyChar = "p"
    ElseIf (Tmp >= 50906 And Tmp <= 51386) Then
       GetPyChar = "q"
    ElseIf (Tmp >= 51387 And Tmp <= 51445) Then
       GetPyChar = "r"
    ElseIf (Tmp >= 51446 And Tmp <= 52217) Then
       GetPyChar = "s"
    ElseIf (Tmp >= 52218 And Tmp <= 52697) Then
       GetPyChar = "t"
    ElseIf (Tmp >= 52698 And Tmp <= 52979) Then
       GetPyChar = "w"
    ElseIf (Tmp >= 52980 And Tmp <= 53688) Then
       GetPyChar = "x"
    ElseIf (Tmp >= 53689 And Tmp <= 54480) Then
       GetPyChar = "y"
    ElseIf (Tmp >= 54481 And Tmp <= 62289) Then
       GetPyChar = "z"
     Else '如果不是中文，则不处理
        GetPyChar = char
    End IfEnd Function

模块：
Option ExplicitPrivate 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(ByVal CHINESE As String, Optional PYTYPE As Integer = 0, Optional Delimiter As String = " ") As StringIf Len(Trim(CHINESE)) > 0 Then
Dim i As Long
Dim s As String
s = Space(255)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As LongReDim a(255) As Long
j = GetKeyboardLayoutList(255, 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 Trim("微软拼音输入法") = Replace(Trim(s), Chr(0), "") Then
IMEInstalled = True
Exit For
End If
End If
Next i
If IMEInstalled Then
CHINESE = Trim(CHINESE)
Dim sChar As String
Dim Buffer0() 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 Len(CHINESE) - 1
sChar = Mid(CHINESE, j + 1, 1)
' If Not InStr("《》，。/？、][{}“”‘’；：！·〈〉「」『』｜〖〗【】（）［］｛｝…—.,""'';:?/\!", sChar) > 0 Then
Buffer0 = 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 = Space(255)
If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) ThenbBuffer0 = 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 = Trim(StrConv(bBuffer, vbUnicode))
If InStr(sChar, vbNullChar) Then
sChar = Trim(Left(sChar, InStr(sChar, vbNullChar) - 1))
End If
End If
End IfEnd If
End If
' End If
GetChineseSpell = GetChineseSpell & Switch(PYTYPE = 0, sChar, PYTYPE = 1, Left(sChar, Len(sChar) - 1), PYTYPE = 2, UCase(Left(sChar, 1))) & IIf(PYTYPE = 2, "", Delimiter) ''返回全拼
Next j
Else ''没安装“微软拼音输入法”,返回一个空格
GetChineseSpell = " "
End If
Else
GetChineseSpell = "" ''输入为空字符串
End If
End Function窗体:Private Sub Command1_Click()
'TEXT1.TEXT初始为"中华人民共和国"
MsgBox "全拼+声调：" & GetChineseSpell(Text1.Text, 0) & vbCrLf & "全拼：" & GetChineseSpell(Text1.Text, 1) & vbCrLf & "拼音首字母：" & GetChineseSpell(Text1.Text, 2)
End Sub这是一个珍贵的代码，奉献给大家！

太感谢了，我最近打算开个碟店，打算用vb写个租碟系统，正好在姓名查询的时候要用到这个代码，好happy啊。楼上的(枕善居）是个好地方啊，好多免费的源码，受益匪浅。同谢。

这是我改网上的一个汉字转拼音的函数。
GetPY是获得拼音的函数。
第一个参数为要转换的字符串，第二个参数可选，是获得拼音的样式，默认为获得所有拼音。第三个参数是各拼音间的分隔符，默认为空
例如：
GetPy("中国人",pyAll,".")="zhong.guo.ren"
GetPy("中国人",pySUb)="ZH"
GetPy("中国人",pyAllSub)="ZHGR"
Public dic As Object
Public Initial As Boolean
Public Enum PYType
    pyALL = 0 '获得所有拼音，默认值
    pySub = 1 '获得首字母
    pyALlSub = 2 '获得所有拼音的首字幕
End EnumPublic Sub Dic_Initial()
    Set dic = CreateObject("Scripting.Dictionary")
    dic.Add -20319, "a"
    dic.Add -20317, "ai"
    dic.Add -20304, "an"
    dic.Add -20295, "ang"
    dic.Add -20292, "ao"
    dic.Add -20283, "ba"
    dic.Add -20265, "bai"
    dic.Add -20257, "ban"
    dic.Add -20242, "bang"
    dic.Add -20230, "bao"
    dic.Add -20051, "bei"
    dic.Add -20036, "ben"
    dic.Add -20032, "beng"
    dic.Add -20026, "bi"
    dic.Add -20002, "bian"
    dic.Add -19990, "biao"
    dic.Add -19986, "bie"
    dic.Add -19982, "bin"
    dic.Add -19976, "bing"
    dic.Add -19805, "bo"
    dic.Add -19784, "bu"
    dic.Add -19775, "ca"
    dic.Add -19774, "cai"
    dic.Add -19763, "can"
    dic.Add -19756, "cang"
    dic.Add -19751, "cao"
    dic.Add -19746, "ce"
    dic.Add -19741, "ceng"
    dic.Add -19739, "cha"
    dic.Add -19728, "chai"
    dic.Add -19725, "chan"
    dic.Add -19715, "chang"
    dic.Add -19540, "chao"
    dic.Add -19531, "che"
    dic.Add -19525, "chen"
    dic.Add -19515, "cheng"
    dic.Add -19500, "chi"
    dic.Add -19484, "chong"
    dic.Add -19479, "chou"
    dic.Add -19467, "chu"
    dic.Add -19289, "chuai"
    dic.Add -19288, "chuan"
    dic.Add -19281, "chuang"
    dic.Add -19275, "chui"
    dic.Add -19270, "chun"
    dic.Add -19263, "chuo"
    dic.Add -19261, "ci"
    dic.Add -19249, "cong"
    dic.Add -19243, "cou"
    dic.Add -19242, "cu"
    dic.Add -19238, "cuan"
    dic.Add -19235, "cui"
    dic.Add -19227, "cun"
    dic.Add -19224, "cuo"
    dic.Add -19218, "da"
    dic.Add -19212, "dai"
    dic.Add -19038, "dan"
    dic.Add -19023, "dang"
    dic.Add -19018, "dao"
    dic.Add -19006, "de"
    dic.Add -19003, "deng"
    dic.Add -18996, "di"
    dic.Add -18977, "dian"
    dic.Add -18961, "diao"
    dic.Add -18952, "die"
    dic.Add -18783, "ding"
    dic.Add -18774, "diu"
    dic.Add -18773, "dong"
    dic.Add -18763, "dou"
    dic.Add -18756, "du"
    dic.Add -18741, "duan"
    dic.Add -18735, "dui"
    dic.Add -18731, "dun"
    dic.Add -18722, "duo"
    dic.Add -18710, "e"
    dic.Add -18697, "en"
    dic.Add -18696, "er"
    dic.Add -18526, "fa"
    dic.Add -18518, "fan"
    dic.Add -18501, "fang"
    dic.Add -18490, "fei"
    dic.Add -18478, "fen"
    dic.Add -18463, "feng"
    dic.Add -18448, "fo"
    dic.Add -18447, "fou"
    dic.Add -18446, "fu"
    dic.Add -18239, "ga"
    dic.Add -18237, "gai"
    dic.Add -18231, "gan"
    dic.Add -18220, "gang"
    dic.Add -18211, "gao"
    dic.Add -18201, "ge"
    dic.Add -18184, "gei"
    dic.Add -18183, "gen"
    dic.Add -18181, "geng"
    dic.Add -18012, "gong"
    dic.Add -17997, "gou"
    dic.Add -17988, "gu"
    dic.Add -17970, "gua"
    dic.Add -17964, "guai"
    dic.Add -17961, "guan"
    dic.Add -17950, "guang"
    dic.Add -17947, "gui"
    dic.Add -17931, "gun"
    dic.Add -17928, "guo"
    dic.Add -17922, "ha"
    dic.Add -17759, "hai"
    dic.Add -17752, "han"
    dic.Add -17733, "hang"
    dic.Add -17730, "hao"
    dic.Add -17721, "he"
    dic.Add -17703, "hei"
    dic.Add -17701, "hen"
    dic.Add -17697, "heng"
    dic.Add -17692, "hong"
    dic.Add -17683, "hou"
    dic.Add -17676, "hu"
    dic.Add -17496, "hua"
    dic.Add -17487, "huai"
    dic.Add -17482, "huan"
    dic.Add -17468, "huang"
    dic.Add -17454, "hui"
    dic.Add -17433, "hun"
    dic.Add -17427, "huo"
    dic.Add -17417, "ji"
    dic.Add -17202, "jia"
    dic.Add -17185, "jian"
    dic.Add -16983, "jiang"
    dic.Add -16970, "jiao"
    dic.Add -16942, "jie"
    dic.Add -16915, "jin"
    dic.Add -16733, "jing"
    dic.Add -16708, "jiong"
    dic.Add -16706, "jiu"
    dic.Add -16689, "ju"
    dic.Add -16664, "juan"
    dic.Add -16657, "jue"
    dic.Add -16647, "jun"
    dic.Add -16474, "ka"
    dic.Add -16470, "kai"
    dic.Add -16465, "kan"
    dic.Add -16459, "kang"
    dic.Add -16452, "kao"
    dic.Add -16448, "ke"
    dic.Add -16433, "ken"
    dic.Add -16429, "keng"
    dic.Add -16427, "kong"
    dic.Add -16423, "kou"
    dic.Add -16419, "ku"
    dic.Add -16412, "kua"
    dic.Add -16407, "kuai"
    dic.Add -16403, "kuan"
    dic.Add -16401, "kuang"
    dic.Add -16393, "kui"
    dic.Add -16220, "kun"
    dic.Add -16216, "kuo"
    dic.Add -16212, "la"
    dic.Add -16205, "lai"
    dic.Add -16202, "lan"
    dic.Add -16187, "lang"
    dic.Add -16180, "lao"
    dic.Add -16171, "le"
    dic.Add -16169, "lei"
    dic.Add -16158, "leng"
    dic.Add -16155, "li"
    dic.Add -15959, "lia"
    dic.Add -15958, "lian"
    dic.Add -15944, "liang"
    dic.Add -15933, "liao"
    dic.Add -15920, "lie"
    dic.Add -15915, "lin"
    dic.Add -15903, "ling"
    dic.Add -15889, "liu"
    dic.Add -15878, "long"
    dic.Add -15707, "lou"
    dic.Add -15701, "lu"
    dic.Add -15681, "lv"
    dic.Add -15667, "luan"
    dic.Add -15661, "lue"
    dic.Add -15659, "lun"
    dic.Add -15652, "luo"
    dic.Add -15640, "ma"
    dic.Add -15631, "mai"
    dic.Add -15625, "man"
    dic.Add -15454, "mang"
    dic.Add -15448, "mao"
    dic.Add -15436, "me"
    dic.Add -15435, "mei"
    dic.Add -15419, "men"
    dic.Add -15416, "meng"
    dic.Add -15408, "mi"
    dic.Add -15394, "mian"
    dic.Add -15385, "miao"
    dic.Add -15377, "mie"
    dic.Add -15375, "min"
    dic.Add -15369, "ming"
    dic.Add -15363, "miu"
    dic.Add -15362, "mo"
    dic.Add -15183, "mou"

dic.Add -15180, "mu"
    dic.Add -15165, "na"
    dic.Add -15158, "nai"
    dic.Add -15153, "nan"
    dic.Add -15150, "nang"
    dic.Add -15149, "nao"
    dic.Add -15144, "ne"
    dic.Add -15143, "nei"
    dic.Add -15141, "nen"
    dic.Add -15140, "neng"
    dic.Add -15139, "ni"
    dic.Add -15128, "nian"
    dic.Add -15121, "niang"
    dic.Add -15119, "niao"
    dic.Add -15117, "nie"
    dic.Add -15110, "nin"
    dic.Add -15109, "ning"
    dic.Add -14941, "niu"
    dic.Add -14937, "nong"
    dic.Add -14933, "nu"
    dic.Add -14930, "nv"
    dic.Add -14929, "nuan"
    dic.Add -14928, "nue"
    dic.Add -14926, "nuo"
    dic.Add -14922, "o"
    dic.Add -14921, "ou"
    dic.Add -14914, "pa"
    dic.Add -14908, "pai"
    dic.Add -14902, "pan"
    dic.Add -14894, "pang"
    dic.Add -14889, "pao"
    dic.Add -14882, "pei"
    dic.Add -14873, "pen"
    dic.Add -14871, "peng"
    dic.Add -14857, "pi"
    dic.Add -14678, "pian"
    dic.Add -14674, "piao"
    dic.Add -14670, "pie"
    dic.Add -14668, "pin"
    dic.Add -14663, "ping"
    dic.Add -14654, "po"
    dic.Add -14645, "pu"
    dic.Add -14630, "qi"
    dic.Add -14594, "qia"
    dic.Add -14429, "qian"
    dic.Add -14407, "qiang"
    dic.Add -14399, "qiao"
    dic.Add -14384, "qie"
    dic.Add -14379, "qin"
    dic.Add -14368, "qing"
    dic.Add -14355, "qiong"
    dic.Add -14353, "qiu"
    dic.Add -14345, "qu"
    dic.Add -14170, "quan"
    dic.Add -14159, "que"
    dic.Add -14151, "qun"
    dic.Add -14149, "ran"
    dic.Add -14145, "rang"
    dic.Add -14140, "rao"
    dic.Add -14137, "re"
    dic.Add -14135, "ren"
    dic.Add -14125, "reng"
    dic.Add -14123, "ri"
    dic.Add -14122, "rong"
    dic.Add -14112, "rou"
    dic.Add -14109, "ru"
    dic.Add -14099, "ruan"
    dic.Add -14097, "rui"
    dic.Add -14094, "run"
    dic.Add -14092, "ruo"
    dic.Add -14090, "sa"
    dic.Add -14087, "sai"
    dic.Add -14083, "san"
    dic.Add -13917, "sang"
    dic.Add -13914, "sao"
    dic.Add -13910, "se"
    dic.Add -13907, "sen"
    dic.Add -13906, "seng"
    dic.Add -13905, "sha"
    dic.Add -13896, "shai"
    dic.Add -13894, "shan"
    dic.Add -13878, "shang"
    dic.Add -13870, "shao"
    dic.Add -13859, "she"
    dic.Add -13847, "shen"
    dic.Add -13831, "sheng"
    dic.Add -13658, "shi"
    dic.Add -13611, "shou"
    dic.Add -13601, "shu"
    dic.Add -13406, "shua"
    dic.Add -13404, "shuai"
    dic.Add -13400, "shuan"
    dic.Add -13398, "shuang"
    dic.Add -13395, "shui"
    dic.Add -13391, "shun"
    dic.Add -13387, "shuo"
    dic.Add -13383, "si"
    dic.Add -13367, "song"
    dic.Add -13359, "sou"
    dic.Add -13356, "su"
    dic.Add -13343, "suan"
    dic.Add -13340, "sui"
    dic.Add -13329, "sun"
    dic.Add -13326, "suo"
    dic.Add -13318, "ta"
    dic.Add -13147, "tai"
    dic.Add -13138, "tan"
    dic.Add -13120, "tang"
    dic.Add -13107, "tao"
    dic.Add -13096, "te"
    dic.Add -13095, "teng"
    dic.Add -13091, "ti"
    dic.Add -13076, "tian"
    dic.Add -13068, "tiao"
    dic.Add -13063, "tie"
    dic.Add -13060, "ting"
    dic.Add -12888, "tong"
    dic.Add -12875, "tou"
    dic.Add -12871, "tu"
    dic.Add -12860, "tuan"
    dic.Add -12858, "tui"
    dic.Add -12852, "tun"
    dic.Add -12849, "tuo"
    dic.Add -12838, "wa"
    dic.Add -12831, "wai"
    dic.Add -12829, "wan"
    dic.Add -12812, "wang"
    dic.Add -12802, "wei"
    dic.Add -12607, "wen"
    dic.Add -12597, "weng"
    dic.Add -12594, "wo"
    dic.Add -12585, "wu"
    dic.Add -12556, "xi"
    dic.Add -12359, "xia"
    dic.Add -12346, "xian"
    dic.Add -12320, "xiang"
    dic.Add -12300, "xiao"
    dic.Add -12120, "xie"
    dic.Add -12099, "xin"
    dic.Add -12089, "xing"
    dic.Add -12074, "xiong"
    dic.Add -12067, "xiu"
    dic.Add -12058, "xu"
    dic.Add -12039, "xuan"
    dic.Add -11867, "xue"
    dic.Add -11861, "xun"
    dic.Add -11847, "ya"
    dic.Add -11831, "yan"
    dic.Add -11798, "yang"
    dic.Add -11781, "yao"
    dic.Add -11604, "ye"
    dic.Add -11589, "yi"
    dic.Add -11536, "yin"
    dic.Add -11358, "ying"
    dic.Add -11340, "yo"
    dic.Add -11339, "yong"
    dic.Add -11324, "you"
    dic.Add -11303, "yu"
    dic.Add -11097, "yuan"
    dic.Add -11077, "yue"
    dic.Add -11067, "yun"
    dic.Add -11055, "za"
    dic.Add -11052, "zai"
    dic.Add -11045, "zan"
    dic.Add -11041, "zang"
    dic.Add -11038, "zao"
    dic.Add -11024, "ze"
    dic.Add -11020, "zei"
    dic.Add -11019, "zen"
    dic.Add -11018, "zeng"
    dic.Add -11014, "zha"
    dic.Add -10838, "zhai"
    dic.Add -10832, "zhan"
    dic.Add -10815, "zhang"
    dic.Add -10800, "zhao"
    dic.Add -10790, "zhe"
    dic.Add -10780, "zhen"
    dic.Add -10764, "zheng"
    dic.Add -10587, "zhi"
    dic.Add -10544, "zhong"
    dic.Add -10533, "zhou"
    dic.Add -10519, "zhu"
    dic.Add -10331, "zhua"
    dic.Add -10329, "zhuai"
    dic.Add -10328, "zhuan"
    dic.Add -10322, "zhuang"
    dic.Add -10315, "zhui"
    dic.Add -10309, "zhun"
    dic.Add -10307, "zhuo"
    dic.Add -10296, "zi"
    dic.Add -10281, "zong"
    dic.Add -10274, "zou"
    dic.Add -10270, "zu"
    dic.Add -10262, "zuan"
    dic.Add -10260, "zui"
    dic.Add -10256, "zun"
    dic.Add -10254, "zuo"
    dic.Add -10247, "zz"
    Initial = True
End SubPublic Function GetPY(str As String, Optional Ptype As PYType = pyALL, Optional Flag As String = "") As String
    Dim i As Integer
    Dim j As Integer
    Dim objKey, objItem
    Dim intTmp As Long
    If Initial = False Then
        Dic_Initial
    End If
    For i = 1 To Len(str)
        intTmp = Asc(Mid(str, i, 1))
        If intTmp > 0 And intTmp < 160 Then
            strTmp = ""
        Else
            If intTmp < -20319 Or intTmp > -10247 Then
                strTmp = ""
            Else
                objItem = dic.Items
                objKey = dic.keys
                For j = dic.Count - 1 To 0 Step -1
                    If objKey(j) <= intTmp Then Exit For
                Next
                Select Case Ptype
                Case 0
                    strTmp = objItem(j)
                Case 1
                    strTmp = UCase(Left(objItem(j), 1))
                    If Len(objItem(j)) > 2 Then
                        If Mid(objItem(j), 2, 1) = "h" Then
                            strTmp = strTmp & "H"
                        End If
                    End If
                    GetPY = strTmp
                    Exit Function
                Case 2
                    strTmp = UCase(Left(objItem(j), 1))
                    If Len(objItem(j)) > 2 Then
                        If Mid(objItem(j), 2, 1) = "h" Then
                            strTmp = strTmp & "H"
                        End If
                    End If
                End Select
                GetPY = GetPY & strTmp & Flag

            End If
        End If    Next
    If Flag <> "" Then
        GetPY = Left(GetPY, Len(GetPY) - 1)
    End If
End Function

调试易

求一取得汉字拼音缩写的函数!

解决方案 »