| Из недостатков - глючит функция временами. Т.е. отказывается работать. Возможно, это связано с русским написанием переменных и названия функции. Если кто разберется в данной проблеме - милости просим высказаться на форуме. Все, что ниже нужно просто вставить в новый модуль.
Option Compare Database
'Option Explicit
Public N(1 To 14) As Byte ' в каждом разряде - число из суммы
Public a, строка As String
Public A1_муж, A1_жен, a2, a3, a0
Public Function Пропись(Сумма, Optional Показывать_ноль_копеек As Boolean)
' Сумма прописью в диапазоне от 0 до 999 млрд. с копейками
' создана 26.11.97 (Бабиков Валерий Анатольевич)
' если параметр Показывать_ноль_копеек = ЛОЖЬ, _
то текст "00 копеек" не добавляется к результату.
A1_муж = Array("", "один ", "два ", "тpи ", "четыpе ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
A1_жен = Array("", "одна ", "две ", "тpи ", "четыpе ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
a0 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
a2 = Array("", "десять ", "двадцать ", "тpидцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
a3 = Array("", "сто ", "двести ", "тpиста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
миллиарды = Array("миллиард", "миллиарда", "миллиардов")
миллионы = Array("миллион", "миллиона", "миллионов")
тысячи = Array("тысяча", "тысячи", "тысяч")
рубли = Array("рубль", "рубля", "рублей")
копейки = Array("копейка", "копейки", "копеек")
a = "" ' собираемая строка суммы прописью
Позиция_разделителя = InStr(1, Сумма, "=", 1) + InStr(1, Сумма, "-", 1) + InStr(1, Сумма, ".", 1) + InStr(1, Сумма, ",", 1)
If Позиция_разделителя = 0 Then
коп = "00"
Позиция_разделителя = Len(Сумма) + 1
Else
коп = Left(Mid(Сумма, Позиция_разделителя + 1, 2) & "00", 2)
End If
строка = Right("000000000000" & Mid(Сумма, 1, Позиция_разделителя - 1), 12)
If Val(строка) < 0 Or Val(строка) > 999999999999.99 Then ' проверка условий
Пропись = "Cумма выходит за границы допустимого диапазона (0-999999999999.99)."
Exit Function
End If
For i = 1 To 12 ' рубли
N(i) = Val(Mid(строка, i, 1))
Next i
For i = 13 To 14 ' копейки
N(i) = Val(Mid(коп, i - 12, 1))
Next i
If Разбор(0) Then ' миллиарды
a = a & миллиарды(Склонение(0)) + " "
End If
If Разбор(3) Then ' миллионы
a = a & миллионы(Склонение(3)) + " "
End If
If Разбор(6) Then ' тысячи
a = a & тысячи(Склонение(6)) + " "
End If
Разбор (9) 'рубли
If a <> "" Then
a = a & рубли(Склонение(9)) & " "
Else
a = "Ноль рублей "
End If
a = UCase(Mid(Trim(a), 1, 1)) & Mid(Trim(a), 2) ' первая прописная
If Not Показывать_ноль_копеек And коп = "00" Then Else _
a = a & " " & коп & " " & копейки(Склонение(11))
Пропись = a
End Function
Function Разбор(Сдвиг) As Boolean
If Val(Mid(строка, 1 + Сдвиг, 3)) <> 0 Then
a = a & a3(N(1 + Сдвиг))
If N(2 + Сдвиг) = 1 Then
a = a & a0(N(3 + Сдвиг))
Else
a = a & a2(N(2 + Сдвиг)) & IIf(Сдвиг = 6, A1_жен(N(3 + Сдвиг)), A1_муж(N(3 + Сдвиг)))
End If
Разбор = True
Else
Разбор = False
End If
End Function
Public Function Склонение(Сдвиг)
If N(2 + Сдвиг) = 1 Then ' от 10 до 19
Склонение = 2
Else
Select Case N(3 + Сдвиг)
Case 1
Склонение = 0
Case 2 To 4
Склонение = 1
Case Else
Склонение = 2
End Select
End If
End Function |
