Страница сайта http://silicontaiga.ru
Оригинал находится по адресу http://silicontaiga.ru/home.asp?artId=6240

Сумма прописью

Администратор

Модуль не наш. Взят из платежки пятилетней давности. Впрочем, написать нечто подобное, если вы немного знакомы с математикой, не составит труда. Однако, спасибо автору за ненужность траты времени на создание созданного.

 
Из недостатков - глючит функция временами. Т.е. отказывается работать. Возможно, это связано с русским написанием переменных и названия функции. Если кто разберется в данной проблеме - милости просим высказаться на форуме. Все, что ниже нужно просто вставить в новый модуль.

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