| thebestperm |
21.05.2009 11:10 |
модуль VBA в MS Access
Здравствуйте!
Вот какая проблема: есть список студентов в Им.падеже, необходимо просклонять все эти фамилии в родительный, дательный и винительный падежи.
Нашел тут какой-то модуль с разными склонениями, хотел приделать к БД, но видимо мозгов не хватает малёха :(
Код:
Rem (c) Jurer Production Begin ( Start )
Rem Номер версии 21 от 05.12.2003 - оптимизация кода + реализация равнодушия к регистрам.
Rem Только не забывайте проголосовать "ИДЕЯ", а то программа будет работать неправильно!
Rem __________________________________________________________________
Rem
Rem SuperJur.Narod.Ru
Rem
Rem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ SuperJur _ _ _ _ _ _ _ _ _ _ _ _ _ _
Rem
Rem _ _ _ _ _ _ _ _ _ _ _ _ _ IQ = ICQ#: 164599984 _ _ _ _ _ _ _ _ _ _
Rem __________________________________________________________________
Rem Сообщения о недоточётах, замечания, пожелания шлите в мыло: [email protected]
Rem Гарантия 93 года и 8 месяцев!!!
Rem Послегарантийное обслуживание - бесплатно!!!
Rem Круглосуточная поддержка - все 24 часа в бою!
Rem Ссылка на источник обязательна!
Rem Эти программы защищены законом об авторских правах
Rem ПРОВЕРЕНО! ВИРУСОВ НЕТ!!! АНТИВИРУСОВ ТОЖЕ!!!
Rem SuperJur = Железняков Юрий Юрьевич ( Рязань - 2003 )
Function ПадежС(z971, z972, z973) As String
Dim z974 As String 'моё
Dim z975 As String 'моё
Dim z976 As String 'моё
Rem z971 - существительное, z972 - номер падежа, z973 - НЕ УКАЗЫВАЕТСЯ
z972 = IIf(IsEmpty(z972), 2, z972)
z973 = IIf(IsEmpty(z973), "*", z973)
z974 = Right(z971, 2)
z975 = IIf(z973 = "1", IIf(z974 = "ая", 8, 9), IIf(z974 = "ия", 7, InStr(".чайяь", Right(z974, 1))))
z976 = Len(z971) - 2
ПадежС = IIf(z972 = 1 Or InStr("ьжан итай", Right(z971, 4)) > 0, z971, IIf(z975 > 2, Left(z971, z976 + IIf(z975 = 8, 0, 1)), IIf(z974 = "ел", Left(z971, z976) + "л", IIf(z974 = "ев" And z973 <> "2", Left(z971, z976) + "ьв", z971))) + RTrim(Mid("а у а " + IIf(z973 = "2", Mid("оыыыее", InStr(" внтч", Right(z974, 1)) + 1, 1), "о") + "ме а у а еме " + IIf(InStr("гжкхш", Left(z974, 1)) > 0, "и", "ы") + " е у ойе я ю я еме и е ю ейе и и ь ьюи и и ю ейи ойойуюойойойойу ойой", 10 * IIf(z975 = 6 And z973 <> "а", 4, z975) + 2 * z972 - 3, 2)))
Rem !-- ЗДЕСЬ МОЖНО ЗАДАТЬ ДРУГИЕ НЕСКЛОНЯЕМЫЕ ИМЕНА по последним четырем буквам - Гульжан Гульчитай
End Function
Function Падеж(z1, z2, z3) As String
Dim z4 As String 'моё
Dim Z5 As String 'моё
Dim z6 As String 'моё
Dim z7 As String 'моё
Dim z8 As String 'моё
Rem z1 - фамилия имя отчество например Железняков Юрий Юрьевич
Rem Падеж
Rem 2 - родительный ( нет кого ? ) Железнякова Юрия Юрьевича
Rem 3 - дательный ( кому ? ) Железнякову Юрию Юрьевичу
Rem 4 - винительный ( вижу кого ? ) Железнякова Юрия Юрьевича
Rem 5 - творительный ( кем ? ) Железняковым Юрием Юрьевичем
Rem 6 - предложный ( о ком ? ) Железнякове Юрие Юрьевиче
Rem Если задать Z2 меньше 0, то на выходе получим от -1=Железняков Ю. Ю. до -6=Железнякове Ю. Ю.
Rem Параметр Пол может не указываться, но при наличии фамилий с
Rem инициалами точное определение пола невозможно, поэтому предлагается задавать пол этим
Rem параметром
Rem 1 - мужской
Rem 2 - женский
Rem ДЛЯ СКЛОНЕНИЕ ПРОФЕССИЙ ИСПОЛЬЗУЙТЕ КОНСТРУКЦИЮ Падеж(Профессия,Падеж,4)
Rem Бибик Галушка Цой Николайчик Наталия Петровна Герценберг Кривошей
z1 = Trim(z1)
z2 = IIf(IsEmpty(z2), 1, z2)
z3 = Mid("ча" + Right(z1, 1) + "ч", IIf(IsEmpty(z3), 3, z3), 1)
z4 = InStr(z1 + " ", " ")
z1 = IIf(z2 > 0, z1, Replace(Left(z1 + " ", z4 + 1) + ". " + Mid(z1, InStr(Mid(z1 + " ", z4 + 2), " ") + z4 + 2, 1) + ".", " .", ""))
z2 = Abs(z2)
Z5 = Left(z1, z4 - 1)
z6 = Right(Z5, 3)
z7 = Right(z6, 2)
z8 = Right(z7, 1)
Z5 = IIf(z3 = "а", IIf(z8 = "а" And z6 <> "ула" Or z7 = "ая", ПадежС(Z5, z2, "1"), Z5), IIf(InStr("ой ый ий", z7) And z6 <> "Цой", Left(Z5, z4 - 3) + (Mid(z7 + " огоомуого" + IIf(z7 = "ий" Or z6 = "гой" Or z6 = "хой", "и", "ы") + "м ом", z2 * 3 - 2, 3)), IIf(InStr("оеиую", z8) + InStr("аа еа ёа иа оа уа ыа эа юа яа", z7) = 0, ПадежС(Z5, z2, "2"), Z5)))
z8 = z4 + InStr(Mid(z1 + " ", z4 + 1), " ")
Падеж = IIf(z3 = "ч" And z4 = Len(z1) + 1, ПадежС(z1, z2, "*"), Z5) + " " + ПадежС(Mid(z1, z4 + 1, z8 - z4 - 1), z2, z3) + " " + ПадежС(Mid(z1, z8 + 1, Len(z1) - z8), z2, z3)
End Function
Rem (c) Jurer Production End ( Finish )
Private Sub Кнопка237_Click() 'моё
Dim my1 As String 'моё
Dim my2 As String 'моё
my1 = ПадежС("Яппаров", "2", "") 'моё
my2 = Падеж("Яппаров Илфат Раифович", "2", "") 'моё
MsgBox (my1) 'моё
MsgBox (my2) 'моё
End Sub
Помогите пожалуйста разобраться :sos: |
