Конвертация из кирилицы в латиницу

[[Zeus]]

Привет!

Кто нить делал функцию конвертации из кирилицы в латиницу или может где есть готовое? Т.е. чтоб слово "табуретка" переводилось в "tabyretka".

[RayShade]

Код: Выделить всё



Private Const strTranslitLower As String = "a b v g d e zhz i j k l m n o p r s t u f h c chshsh   i   ejuya"

Private Const strTranslitUpper As String = "A B V G D E ZhZ I J K L M N O P R S T U F H C ChShSh   I   EJuYa"



Private Function Transliterate(ByRef lWhat As String) As String

Dim i As Long

Dim strResult As String

For i = 1 To Len(lWhat)

Select Case Asc(Mid(lWhat, i, 1))

Case 224 To 255: strResult = strResult & Trim(Mid(strTranslitLower, (Asc(Mid(lWhat, i, 1)) - 223) * 2 - 1, 2))

Case 192 To 223: strResult = strResult & Trim(Mid(strTranslitUpper, (Asc(Mid(lWhat, i, 1)) - 191) * 2 - 1, 2))

Case 184: strResult = strResult & "e"

Case 168: strResult = strResult & "E"

Case Else: strResult = strResult & Mid(lWhat, i, 1)

End Select

Next i

Transliterate = strResult

End Function