Красиивая природа⁠⁠

Option Explicit

' Функция суммы прописью (например: 1234,56 -> "Одна тысяча двести тридцать четыре рубля 56 копеек")
Public Function СуммаПрописью(Сумма As Double) As String
Dim ЦелаяЧасть As Currency
Dim ДробнаяЧасть As Integer
Dim СтрокаРезультат As String
Dim Триады() As String
Dim i As Integer
Dim Разряд As Integer
Dim ТекстТриады As String

' Обработка отрицательной суммы
If Сумма < 0 Then
СтрокаРезультат = "Минус " & СуммаПрописью(-Сумма)
СтрокаРезультат = UCase(Left(СтрокаРезультат, 1)) & Mid(СтрокаРезультат, 2)
СуммаПрописью = СтрокаРезультат
Exit Function
End If

' Разделяем целую и дробную части
ЦелаяЧасть = Int(Сумма)
ДробнаяЧасть = Round((Сумма - ЦелаяЧасть) * 100, 0)

' Преобразуем целую часть в слова
If ЦелаяЧасть = 0 Then
ТекстТриады = "ноль"
Else
' Разбиваем целую часть на триады (разряды по 3 цифры)
Dim ВременнаяСтрока As String
ВременнаяСтрока = Format(ЦелаяЧасть, "0")
Dim Длина As Integer
Длина = Len(ВременнаяСтрока)
Dim Триада As String
Dim Позиция As Integer
Dim НомерТриады As Integer
НомерТриады = 0
ТекстТриады = ""

' Идем справа налево по три цифры
For Позиция = Длина To 1 Step -3
If Позиция - 2 <= 0 Then
Триада = Left(ВременнаяСтрока, Позиция)
Else
Триада = Mid(ВременнаяСтрока, Позиция - 2, 3)
End If

' Преобразуем триаду в слова с учетом разряда (0 - единицы, 1 - тысячи, 2 - миллионы, 3 - миллиарды)
Dim СловаТриады As String
СловаТриады = ПреобразоватьТриаду(Val(Триада), НомерТриады)

If СловаТриады <> "" Then
If ТекстТриады <> "" Then
ТекстТриады = СловаТриады & " " & ТекстТриады
Else
ТекстТриады = СловаТриады
End If
End If

НомерТриады = НомерТриады + 1
Next Позиция
End If

' Добавляем рубли с правильным склонением
ТекстТриады = ТекстТриады & " " & СклонениеРублей(ЦелаяЧасть)

' Добавляем копейки
If ДробнаяЧасть < 10 Then
ТекстТриады = ТекстТриады & " " & "0" & ДробнаяЧасть & " " & СклонениеКопеек(ДробнаяЧасть)
Else
ТекстТриады = ТекстТриады & " " & ДробнаяЧасть & " " & СклонениеКопеек(ДробнаяЧасть)
End If

' Делаем первую букву заглавной
СтрокаРезультат = UCase(Left(ТекстТриады, 1)) & Mid(ТекстТриады, 2)

СуммаПрописью = СтрокаРезультат
End Function

' Преобразование трёхзначного числа в слова с учётом разряда
Private Function ПреобразоватьТриаду(Число As Integer, Разряд As Integer) As String
Dim Сотни As Integer
Dim Десятки As Integer
Dim Единицы As Integer
Dim Результат As String

If Число = 0 Then
ПреобразоватьТриаду = ""
Exit Function
End If

Сотни = Число \ 100
Десятки = (Число Mod 100) \ 10
Единицы = Число Mod 10

' Сотни
Select Case Сотни
Case 1: Результат = "сто"
Case 2: Результат = "двести"
Case 3: Результат = "триста"
Case 4: Результат = "четыреста"
Case 5: Результат = "пятьсот"
Case 6: Результат = "шестьсот"
Case 7: Результат = "семьсот"
Case 8: Результат = "восемьсот"
Case 9: Результат = "девятьсот"
End Select

' Десятки и единицы (обработка чисел от 10 до 19 отдельно)
If (Число Mod 100) >= 10 And (Число Mod 100) <= 19 Then
Dim Особые As Integer
Особые = Число Mod 100
Select Case Особые
Case 10: Результат = Результат & " десять"
Case 11: Результат = Результат & " одиннадцать"
Case 12: Результат = Результат & " двенадцать"
Case 13: Результат = Результат & " тринадцать"
Case 14: Результат = Результат & " четырнадцать"
Case 15: Результат = Результат & " пятнадцать"
Case 16: Результат = Результат & " шестнадцать"
Case 17: Результат = Результат & " семнадцать"
Case 18: Результат = Результат & " восемнадцать"
Case 19: Результат = Результат & " девятнадцать"
End Select
' Для особых чисел единицы не обрабатываем отдельно
Единицы = 0
Десятки = 0
Else
' Десятки
Select Case Десятки
Case 2: Результат = Результат & " двадцать"
Case 3: Результат = Результат & " тридцать"
Case 4: Результат = Результат & " сорок"
Case 5: Результат = Результат & " пятьдесят"
Case 6: Результат = Результат & " шестьдесят"
Case 7: Результат = Результат & " семьдесят"
Case 8: Результат = Результат & " восемьдесят"
Case 9: Результат = Результат & " девяносто"
End Select
End If

' Единицы (если не были обработаны в особом случае)
If Единицы > 0 Then
Select Case Единицы
Case 1: Результат = Результат & " один"
Case 2: Результат = Результат & " два"
Case 3: Результат = Результат & " три"
Case 4: Результат = Результат & " четыре"
Case 5: Результат = Результат & " пять"
Case 6: Результат = Результат & " шесть"
Case 7: Результат = Результат & " семь"
Case 8: Результат = Результат & " восемь"
Case 9: Результат = Результат & " девять"
End Select
End If

' Убираем лишние пробелы
Результат = Trim(Результат)

' Добавляем название разряда (тысячи, миллионы, миллиарды)
If Разряд = 1 Then ' тысячи
' Для тысяч нужно склонение
If Единицы = 1 And Десятки <> 1 Then
Результат = Replace(Результат, "один", "одна")
Результат = Replace(Результат, "два", "две")
End If
Результат = Результат & " " & СклонениеТысяч(Число)
ElseIf Разряд = 2 Then ' миллионы
Результат = Результат & " " & СклонениеМиллионов(Число)
ElseIf Разряд = 3 Then ' миллиарды
Результат = Результат & " " & СклонениеМиллиардов(Число)
End If

ПреобразоватьТриаду = Результат
End Function

' Склонение слова "рубль"
Private Function СклонениеРублей(Число As Currency) As String
Dim ПоследняяЦифра As Integer
Dim ПоследниеДве As Integer

ПоследняяЦифра = Число Mod 10
ПоследниеДве = Число Mod 100

If ПоследниеДве >= 11 And ПоследниеДве <= 19 Then
СклонениеРублей = "рублей"
Else
Select Case ПоследняяЦифра
Case 1: СклонениеРублей = "рубль"
Case 2, 3, 4: СклонениеРублей = "рубля"
Case Else: СклонениеРублей = "рублей"
End Select
End If
End Function

' Склонение слова "тысяча"
Private Function СклонениеТысяч(Число As Integer) As String
Dim ПоследняяЦифра As Integer
Dim ПоследниеДве As Integer

ПоследняяЦифра = Число Mod 10
ПоследниеДве = Число Mod 100

If ПоследниеДве >= 11 And ПоследниеДве <= 19 Then
СклонениеТысяч = "тысяч"
Else
Select Case ПоследняяЦифра
Case 1: СклонениеТысяч = "тысяча"
Case 2, 3, 4: СклонениеТысяч = "тысячи"
Case Else: СклонениеТысяч = "тысяч"
End Select
End If
End Function

' Склонение слова "миллион"
Private Function СклонениеМиллионов(Число As Integer) As String
Dim ПоследняяЦифра As Integer
Dim ПоследниеДве As Integer

ПоследняяЦифра = Число Mod 10
ПоследниеДве = Число Mod 100

If ПоследниеДве >= 11 And ПоследниеДве <= 19 Then
СклонениеМиллионов = "миллионов"
Else
Select Case ПоследняяЦифра
Case 1: СклонениеМиллионов = "миллион"
Case 2, 3, 4: СклонениеМиллионов = "миллиона"
Case Else: СклонениеМиллионов = "миллионов"
End Select
End If
End Function

' Склонение слова "миллиард"
Private Function СклонениеМиллиардов(Число As Integer) As String
Dim ПоследняяЦифра As Integer
Dim ПоследниеДве As Integer

ПоследняяЦифра = Число Mod 10
ПоследниеДве = Число Mod 100

If ПоследниеДве >= 11 And ПоследниеДве <= 19 Then
СклонениеМиллиардов = "миллиардов"
Else
Select Case ПоследняяЦифра
Case 1: СклонениеМиллиардов = "миллиард"
Case 2, 3, 4: СклонениеМиллиардов = "миллиарда"
Case Else: СклонениеМиллиардов = "миллиардов"
End Select
End If
End Function

' Склонение слова "копейка"
Private Function СклонениеКопеек(Число As Integer) As String
Dim ПоследняяЦифра As Integer
Dim ПоследниеДве As Integer

ПоследняяЦифра = Число Mod 10
ПоследниеДве = Число Mod 100

If ПоследниеДве >= 11 And ПоследниеДве <= 19 Then
СклонениеКопеек = "копеек"
Else
Select Case ПоследняяЦифра
Case 1: СклонениеКопеек = "копейка"
Case 2, 3, 4: СклонениеКопеек = "копейки"
Case Else: СклонениеКопеек = "копеек"
End Select
End If
End Function