Function РубПропись(Сумма As Double, Optional Без_копеек As Boolean = False, _
                     Optional КопПрописью As Boolean = False, Optional начинитьПрописной As Boolean = True) As String
'Функция для написания суммы прописью
     Dim ed, des, sot, ten, razr, dec
     Dim i As Integer, str As String, s As String
     Dim intPart As String, frPart As String
     Dim mlnEnd, tscEnd, razrEnd, rub, cop

     dec = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
     ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
     ten = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
     des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
     sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
     razr = Array("", "тысяч", "миллион", "миллиард")
     mlnEnd = Array("ов ", " ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ")
     tscEnd = Array(" ", "а ", "и ", "и ", "и ", " ", " ", " ", " ", " ")
     razrEnd = Array(mlnEnd, mlnEnd, tscEnd, "")
     rub = Array("рублей", "рубль", "рубля", "рубля", "рубля", "рублей", "рублей", "рублей", "рублей", "рублей")
     cop = Array("копеек", "копейка", "копейки", "копейки", "копейки", "копеек", "копеек", "копеек", "копеек", "копеек")

     If Сумма >= 1000000000000# Or Сумма < 0 Then РубПропись = CVErr(xlErrValue): Exit Function
     '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
     If Round(Сумма, 2) >= 1 Then
         intPart = Left(Format(Сумма, "000000000000.00"), 12)
         For i = 0 To 3
             s = Mid(intPart, i * 3 + 1, 3)
             If s <> "000" Then
                 str = str & sot(CInt(Left(s, 1)))
                 If Mid(s, 2, 1) = "1" Then
                     str = str & ten(CInt(Right(s, 1)))
                 Else
                     str = str & des(CInt(Mid(s, 2, 1))) & IIf(i = 2, dec(CInt(Right(s, 1))), ed(CInt(Right(s, 1))))
                 End If
                 On Error Resume Next
                 str = str & IIf(Mid(s, 2, 1) = "1", razr(3 - i) & razrEnd(i)(0), _
                    razr(3 - i) & razrEnd(i)(CInt(Right(s, 1))))
                 On Error GoTo 0
             End If
         Next i
         str = str & IIf(Mid(s, 2, 1) = "1", rub(0), rub(CInt(Right(s, 1))))
     End If
     РубПропись = str
     '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
     If Без_копеек = False Then
         frPart = Right(Format(Сумма, "0.00"), 2)
         If frPart = "00" Then
             frPart = ""
         Else
             If КопПрописью Then
                 frPart = IIf(Left(frPart, 1) = "1", ten(CInt(Right(frPart, 1))) & cop(0), _
                    des(CInt(Left(frPart, 1))) & dec(CInt(Right(frPart, 1))) & cop(CInt(Right(frPart, 1))))
             Else
                 frPart = IIf(Left(frPart, 1) = "1", frPart & " " & cop(0), frPart & " " & cop(CInt(Right(frPart, 1))))
             End If
         End If
     РубПропись = str & " " & frPart
     End If
     '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
     If начинитьПрописной Then РубПропись = UCase(Left(РубПропись, 1)) & Mid(РубПропись, 2)
End Function