Сумма Прописью по Владимиру Яркову (короткая)

Владимир Ярков vny_762@opsb.ru  

'Функция вывода суммы прописью в рублях и цифрами в копейках

'синтаксис: funSupr(число[,вариант])

'знак числа не учитывается

'первый аргумент - число (Variant) до 10 триллионов

'второй аргумент =0 - возвращает сумму с первой прописной,

' остальные - строчными буквами

' <>0 возвращает сумму строчными буквами

Public Function funSupr(xsu As Variant, Optional mb As Byte) As String

On Error GoTo ersupr

If Not IsNumeric(xsu) Then

funSupr = ""

Exit Function

End If

If xsu >= 10000000000000# Then

funSupr = "слишком большое число"

Exit Function

End If

Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer

If Fix(xsu) = 0 Then

funSupr = "ноль рублей "

Else

ssu = Mid$(Str$(Fix(xsu)), 2) ' строка рублей без знака

nsu = (Len(ssu) + 2) \ 3 ' количество троек цифр

ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu ' добавляем нулями

For i = nsu To 1 Step -1

sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1)) ' сотни

des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1)) ' десятки

edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1)) ' единицы

If sot + des + edi > 0 Or i = 1 Then

If sot > 0 Then

funSupr = funSupr + Choose(sot, "сто", "двести", "триста", _

"четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _

"девятьсот") + " "

End If

If des = 1 Then

funSupr = funSupr + Choose(edi + 1, "десять", "одиннадцать", _

"двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _

"семнадцать", "восемнадцать", "девятнадцать") + " "

ind = 3

Else

If des <> 0 Then

funSupr = funSupr + Choose(des - 1, "двадцать", _

"тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _

"девяносто") + " "

End If

If edi <> 0 Then ' вычисляем индекс для тысяч (одна,две)

If i = 2 And (edi = 1 Or edi = 2) Then

ind = 9

Else

ind = 0

End If

funSupr = funSupr + Choose(edi + ind, "один", "два", _

"три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _

"две") + " "

End If

Select Case edi

Case 1

ind = 1

Case 2, 3, 4

ind = 2

Case Else

ind = 3

End Select

End If

funSupr = funSupr + Choose((i - 1) * 3 + ind, "рубль", "рубля", _

"рублей", "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _

"миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _

"триллионов") + " "

End If

Next i

End If

ssu = Right$(Format$(xsu, "0.00"), 2)

des = Val(Left$(ssu, 1))

edi = Val(Right$(ssu, 1))

If des = 1 Then

ind = 3

Else

Select Case edi

Case 1

ind = 1

Case 2, 3, 4

ind = 2

Case Else

ind = 3

End Select

End If

funSupr = funSupr + ssu + Choose(ind, " копейка", " копейки", " копеек")

If mb = 0 Then

funSupr = UCase$(Left$(funSupr, 1)) + Mid$(funSupr, 2)

End If

Exit Function

ersupr:

funSupr = "ошибка"

End Function