RedPromo
Full Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
'конвертит все символы в строчке
Function latinStr(ByVal sStr As String)
Dim iCount, i As Integer
Dim sChar As String
Dim Res As String
Dim ByCode As Integer
Res = ""
iCount = Len(sStr)
For i = 1 To iCount Step 1
sChar = Mid(sStr, i, 1)
Select Case sChar
Case "ф", "Ф"
Res = Res + "f"
Case "ы", "Ы"
Res = Res + "i"
Case "в", "В"
Res = Res + "v"
Case "а", "А"
Res = Res + "a"
Case "п", "П"
Res = Res + "p"
Case "р", "Р"
Res = Res + "r"
Case "о", "О"
Res = Res + "o"
Case "л", "Л"
Res = Res + "l"
Case "д", "Д"
Res = Res + "d"
Case "ж", "Ж"
Res = Res + "j"
Case "э", "Э"
Res = Res + "e"
Case "й", "Й"
Res = Res + "y"
Case "ц", "Ц"
Res = Res + "c"
Case "у", "У"
Res = Res + "u"
Case "к", "К"
Res = Res + "k"
Case "е", "Е"
Res = Res + "e"
Case "н", "Н"
Res = Res + "n"
Case "г", "Г"
Res = Res + "g"
Case "ш", "Ш"
Res = Res + "h"
Case "щ", "Щ"
Res = Res + "ch"
Case "з", "З"
Res = Res + "z"
Case "х", "Х"
Res = Res + "h"
Case "ъ", "Ъ"
Res = Res + ""
Case "я", "Я"
Res = Res + "y"
Case "ч", "Ч"
Res = Res + "ch"
Case "с", "С"
Res = Res + "s"
Case "м", "М"
Res = Res + "m"
Case "и", "И"
Res = Res + "i"
Case "т", "Т"
Res = Res + "t"
Case "ь", "Ь"
Res = Res + ""
Case "б", "Б"
Res = Res + "b"
Case "ю", "Ю"
Res = Res + "u"
End Select
Next
latinStr = Res
End Function
'выделяем фамилию имя отчество и конвертит
Function ConvertFIO(ByVal sBuff As String)
Dim sF, sI, sO As String
Dim pos As Integer
sBuff = Trim(sBuff)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos < 1 Then
ConvertFIO = "error"
Return
End If
sF = Left(sBuff, pos - 1)
sBuff = Mid(sBuff, pos + 1)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos > 0 Then
sI = Left(sBuff, 1)
sO = Mid(sBuff, pos + 1, 1)
End If
ConvertFIO = latinStr(sF) & latinStr(sI) & latinStr(sO)
End Function
[/code]
|
Всего записей: 558 | Зарегистр. 05-04-2006 | Отправлено: 16:22 05-05-2008 | Исправлено: RedPromo, 16:28 05-05-2008 |
|
