中文转换成拼音函数

 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '中文转换成拼音函数
    Public Function GetChinesePYCode(ByVal SourceStr As String) As String
        Dim Serial_S As String
        Dim Serial_T As String
        Dim TempS As String
        Dim J As Integer

        Dim I As Integer
        Dim HelpChar As String
        Dim GetHelpCode As String
        Serial_S = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座"
        Serial_T = "abcdefghjklmnopqrstwxyz"

        For I = 1 To Len(SourceStr)
            HelpChar = Mid(SourceStr, I, 1)

            If Asc(HelpChar) >= Asc(Left(Serial_S, 1)) And Asc(HelpChar) <= Asc(Right(Serial_S, 1)) Then
                '-------------------------------
                If Asc(HelpChar) = Asc(Right(Serial_S, 1)) Then
                    GetChinesePYCode = GetHelpCode & Right(Serial_T, 1)
                Else
                    For J = 2 To Len(Serial_S)
                        TempS = Mid(Serial_S, J, 1)
                        If Asc(HelpChar) < Asc(TempS) Then
                            GetChinesePYCode = GetChinesePYCode & Mid(Serial_T, J - 1, 1)
                            Exit For
                        End If

                    Next J
                End If

                '-------------------------------
            Else
                GetChinesePYCode = GetChinesePYCode & HelpChar
                GetHelpCode = GetHelpCode & "?"
            End If

        Next I

    End Function

posted on 2006-08-22 15:11  奇远  阅读(865)  评论(0编辑  收藏  举报

导航