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

Давно пользуюсь - "мин" нет.

'--------------------------------------------------------------------------

' Module : modSumProp

' Author : Коллектив ()

' Date : Прибл. 1996 - 1998

' Purpose : Формирование Суммы прописью (Типа: "Двадцать пять рублей 33 копейки.")

' : При аргумете bInWeight = True - вернёт килограммы и граммы (Типа: "Двадцать пять кг. 33 гр.")

'--------------------------------------------------------------------------

' Посл. Редакция: es 09.12.2016

'-----------------------------------------------------------------------------

Option Compare Database 'Использовать порядок сортировки базы данных

Option Explicit 'Вкл. обязательного объявления переменных

Private Skl As Byte

Public Function StrSum(n As Currency, Optional rub As Boolean = True, Optional bInWeight As Boolean = False) As String

'Аргументы:

' n = сумма в формате Currency

' rub = false - без копеек, true - полностью (по умолчанию)

' bInWeight = false (по умолчанию) - сумма прописью, true - Возвращаем: килограммы и граммы

'-----------------------------------------------------------------------------

'Назначение: Конвертирует сумму в сумму прописью (или в килограммы и граммы)

'Возвращает: Сумму прописью ("Двадцать пять рублей 33 копейки." или "Двадцать пять кг. 330 гр.")

'-----------------------------------------------------------------------------

Dim s$, R$, K$

Dim t%, u%, v%, w%

If bInWeight = True Then rub = False 'Для возврата в килограммах и граммах: Агумент rub должен быть = False!

s = ""

If n < 0 Then

n = Abs(n)

s = "минус"

End If

'-----------------------------------------------------------------------------

v = (n - Fix(n)) * 100 ' Число копеек

If bInWeight = True Then

v = (n - Fix(n)) * 1000 ' Число копеек

End If

w = val(Right(Format(v), 1)) ' Получить число единиц копеек

n = Fix(n) ' Целое число рублей

t = val(Right(Format(n), 2)) ' Получить две последние цифры рублей

u = val(Right(t, 1)) ' Получить число единиц рублей

If t > 10 And t < 15 Then

R = " рублей" ' Получить подпись для рублей

ElseIf u = 1 Then

R = " рубль"

ElseIf u > 1 And u < 5 Then

R = " рубля"

Else

R = " рублей"

End If

If v > 10 And v < 15 Then

K = " копеек." ' Получить подпись для копеек

ElseIf w = 1 Then

K = " копейка."

ElseIf w > 1 And w < 5 Then

K = " копейки."

Else

K = " копеек."

End If

'-----------------------------------------------------------------------------

If n > 1000000000000# Then

s = AddStr(s, StrSum2(Int(n / 1000000000000#), True))

Select Case Skl

Case 0: s = AddStr(s, "триллион")

Case 1: s = AddStr(s, "триллиона")

Case 2: s = AddStr(s, "триллионов")

End Select

n = n - Int(n / 1000000000000#) * 1000000000000#

End If

If n > 1000000000 Then

s = AddStr(s, StrSum2(Int(n / 1000000000), True))

Select Case Skl

Case 0: s = AddStr(s, "миллиард")

Case 1: s = AddStr(s, "миллиарда")

Case 2: s = AddStr(s, "миллиардов")

End Select

n = n - Int(n / 1000000000) * 1000000000

End If

If n > 1000000 Then

s = AddStr(s, StrSum2(n \ 1000000, True))

Select Case Skl

Case 0: s = AddStr(s, "миллион")

Case 1: s = AddStr(s, "миллиона")

Case 2: s = AddStr(s, "миллионов")

End Select

n = n Mod 1000000

End If

If n > 1000 Then

s = AddStr(s, StrSum2(n \ 1000, False))

Select Case Skl

Case 0: s = AddStr(s, "тысяча")

Case 1: s = AddStr(s, "тысячи")

Case 2: s = AddStr(s, "тысяч")

End Select

n = n Mod 1000

End If

If n > 0 Then

s = AddStr(s, StrSum2(n, True))

End If

If s = "" Then

s = "ноль"

ElseIf s = "минус" Then

s = s + " ноль"

End If

StrSum = StrConv(Mid(s, 1, 1), vbUpperCase) + Mid(s, 2, Len(s) - 1)

If (rub) Then

StrSum = StrSum & R & Format(v, " 00") & K

Else

If bInWeight = True Then

StrSum = StrSum & " кг." & Format(v, " 000") & " гр."

End If

End If

End Function

'-----------------------------------------------------------------------------

Private Function StrSum2(n As Currency, male As Boolean) As String

Dim s As String

s = ""

If n >= 100 Then

s = StrSum1(((n \ 100) * 100), male)

n = n Mod 100

End If

If n >= 20 Then

s = AddStr(s, StrSum1(((n \ 10) * 10), male))

n = n Mod 10

End If

StrSum2 = AddStr(s, StrSum1(n, male))

End Function

'-----------------------------------------------------------------------------

Private Function StrSum1(n As Currency, male As Boolean) As String

Skl = 2

Select Case n

Case 100: StrSum1 = "сто"

Case 200: StrSum1 = "двести"

Case 300: StrSum1 = "триста"

Case 400: StrSum1 = "четыреста"

Case 500: StrSum1 = "пятьсот"

Case 600: StrSum1 = "шестьсот"

Case 700: StrSum1 = "семьсот"

Case 800: StrSum1 = "восемьсот"

Case 900: StrSum1 = "девятьсот"

Case 11: StrSum1 = "одиннадцать"

Case 12: StrSum1 = "двенадцать"

Case 13: StrSum1 = "тринадцать"

Case 14: StrSum1 = "четырнадцать"

Case 15: StrSum1 = "пятнадцать"

Case 16: StrSum1 = "шестнадцать"

Case 17: StrSum1 = "семнадцать"

Case 18: StrSum1 = "восемнадцать"

Case 19: StrSum1 = "девятнадцать"

Case 20: StrSum1 = "двадцать"

Case 30: StrSum1 = "тридцать"

Case 40: StrSum1 = "сорок"

Case 50: StrSum1 = "пятьдесят"

Case 60: StrSum1 = "шестьдесят"

Case 70: StrSum1 = "семьдесят"

Case 80: StrSum1 = "восемьдесят"

Case 90: StrSum1 = "девяносто"

Case 1

Skl = 0

If male Then

StrSum1 = "один"

Else

StrSum1 = "одна"

End If

Case 2

Skl = 1

If male Then

StrSum1 = "два"

Else

StrSum1 = "две"

End If

Case 3: Skl = 1: StrSum1 = "три"

Case 4: Skl = 1: StrSum1 = "четыре"

Case 5: StrSum1 = "пять"

Case 6: StrSum1 = "шесть"

Case 7: StrSum1 = "семь"

Case 8: StrSum1 = "восемь"

Case 9: StrSum1 = "девять"

Case 10: StrSum1 = "десять"

End Select

End Function

'-----------------------------------------------------------------------------

Private Function AddStr(S1 As String, S2 As String)

If S1 = "" Then

AddStr = S2

ElseIf S2 = "" Then

AddStr = S1

Else

AddStr = S1 + " " + S2

End If

End Function