会员登录 - 用户注册 - 网站地图 Office中国(office-cn.net),专业Office论坛
当前位置:主页 > 技巧 > Access技巧 > 模块函数VBA > 正文

取得汉语拼音的函数

时间:2004-01-06 00:08 来源:Access QQ 作者:黄海 阅读:

Public Function HZ2PY(Tstr As String, Optional onlyFirst As Boolean) As String
    On Error GoTo Err

    If onlyFirst Then Tstr = Left(Tstr, 1)

    Dim intTstrLong As Integer
    Dim strPY As String
    Dim i As Long, p As Integer
    For intTstrLong = 1 To Len(Tstr)

        i = Asc(Mid(Tstr, intTstrLong, 1))
        If i <= Asc("啊") Or i >= Asc("座") Then
            strPY = strPY & Mid(Tstr, intTstrLong, 1)

        Else

            If i >= Asc("啊") And i < Asc("芭") Then p = 65
            If i >= Asc("芭") And i < Asc("擦") Then p = 66
            If i >= Asc("擦") And i < Asc("搭") Then p = 67
            If i >= Asc("搭") And i < Asc("蛾") Then p = 68
            If i >= Asc("蛾") And i < Asc("发") Then p = 69
            If i >= Asc("发") And i < Asc("噶") Then p = 70
            If i >= Asc("噶") And i < Asc("哈") Then p = 71
            If i >= Asc("哈") And i < Asc("击") Then p = 72
            If i >= Asc("击") And i < Asc("喀") Then p = 74
            If i >= Asc("喀") And i < Asc("垃") Then p = 75
            If i >= Asc("垃") And i < Asc("妈") Then p = 76
            If i >= Asc("妈") And i < Asc("拿") Then p = 77
            If i >= Asc("拿") And i < Asc("哦") Then p = 78
            If i >= Asc("哦") And i < Asc("啪") Then p = 79
            If i >= Asc("啪") And i < Asc("欺") Then p = 80
            If i >= Asc("欺") And i < Asc("然") Then p = 81
            If i >= Asc("然") And i < Asc("撒") Then p = 82
            If i >= Asc("撒") And i < Asc("塌") Then p = 83
            If i >= Asc("塌") And i < Asc("挖") Then p = 84
            If i >= Asc("挖") And i < Asc("昔") Then p = 87
            If i >= Asc("昔") And i < Asc("压") Then p = 88
            If i >= Asc("压") And i < Asc("匝") Then p = 89
            If i >= Asc("匝") And i <= Asc("座") Then p = 90
            strPY = strPY & Chr(p)

        End If

    Next intTstrLong

    HZ2PY = strPY

    Exit Function

Err:

    MsgBox Err.Number & Err.Description

End Function

(责任编辑:admin)

顶一下
(2)
100%
踩一下
(0)
0%
发表评论
请自觉遵守互联网相关的政策法规,严禁发布色情、暴力、反动的言论。
评价: