[/CODE][CODE]
'Сумма Прописью по Владимиру Яркову (короткая)
'Владимир Ярков
'Функция вывода суммы прописью в рублях и цифрами в копейках
'синтаксис: fSUMprop(число[,вариант])
'знак числа не учитывается
'первый аргумент - число (Variant) до 10 триллионов
'второй аргумент =0 - возвращает сумму с первой прописной,
'                     остальные - строчными буквами
'               <>0 возвращает сумму строчными буквами
Public Function fSUMprop(xsu As Variant, Optional mb As Byte) As String
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
    fSUMprop = ""
    Exit Function
End If
If xsu >= 10000000000000# Then
    fSUMprop = "слишком большое число"
    Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
    fSUMprop = "ноль рублей "
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
                fSUMprop = fSUMprop + Choose(sot, "сто", "двести", "триста", _
                                             "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
                                             "девятьсот") + " "
            End If
            If des = 1 Then
                fSUMprop = fSUMprop + Choose(edi + 1, "десять", "одиннадцать", _
                                             "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
                                             "семнадцать", "восемнадцать", "девятнадцать") + " "
                ind = 3
            Else
                If des <> 0 Then
                    fSUMprop = fSUMprop + 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
                    fSUMprop = fSUMprop + 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
            fSUMprop = fSUMprop + 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
fSUMprop = fSUMprop + ssu + Choose(ind, " копейка", " копейки", " копеек")
If mb = 0 Then
    fSUMprop = UCase$(Left$(fSUMprop, 1)) + Mid$(fSUMprop, 2)
End If
Exit Function
ersupr:
fSUMprop = "ошибка"
End Function