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

' Сумма прописью для Excel — https://usdinfo.ru/raschet/summa-propisyu/
'   =СуммаПрописью(A1)              Одна тысяча двести двадцать рублей 00 копеек
'   =СуммаПрописью(A1; "USD")       валюта: RUB (по умолчанию), USD, EUR, CNY, KZT, BYN
'   =СуммаПрописью(A1; ; ИСТИНА)    1 220 (Одна тысяча двести двадцать) рублей 00 копеек
' Копейки — цифрами. До 999 999 999 999,99; отрицательное число — #ЧИСЛО!, текст — #ЗНАЧ!
Option Explicit

Public Function СуммаПрописью(Сумма As Variant, Optional Валюта As String = "RUB", Optional Цифрами As Boolean = False) As Variant
    Dim v As Variant, kop As Double, rub As Double, cents As Long
    Dim major As Variant, minor As Variant, w As String

    v = Сумма ' ссылка на ячейку -> её значение; пустая ячейка -> 0
    If IsEmpty(v) Then v = 0
    If Not IsNumeric(v) Then СуммаПрописью = CVErr(2015): Exit Function ' #ЗНАЧ!
    If v < 0 Then СуммаПрописью = CVErr(2036): Exit Function ' #ЧИСЛО!
    kop = Int(CDbl(v) * 100 + 0.5 + 0.0000001) ' до копейки, половина — вверх (1e-7 гасит 1220,555 * 100 = 122055,4999…)
    rub = Int(kop / 100)
    cents = CLng(kop - rub * 100)
    If rub > 999999999999# Then СуммаПрописью = CVErr(2036): Exit Function

    Select Case UCase$(Валюта)
        Case "RUB", ""
            major = Array("рубль", "рубля", "рублей"): minor = Array("копейка", "копейки", "копеек")
        Case "USD"
            major = Array("доллар США", "доллара США", "долларов США"): minor = Array("цент", "цента", "центов")
        Case "EUR"
            major = Array("евро", "евро", "евро"): minor = Array("евроцент", "евроцента", "евроцентов")
        Case "CNY"
            major = Array("китайский юань", "китайских юаня", "китайских юаней"): minor = Array("фэнь", "фэня", "фэней")
        Case "KZT"
            major = Array("тенге", "тенге", "тенге"): minor = Array("тиын", "тиына", "тиынов")
        Case "BYN"
            major = Array("белорусский рубль", "белорусских рубля", "белорусских рублей"): minor = Array("копейка", "копейки", "копеек")
        Case Else
            СуммаПрописью = CVErr(2015): Exit Function
    End Select

    w = NumberWords(rub)
    w = UCase$(Left$(w, 1)) & Mid$(w, 2)
    If Цифрами Then w = GroupDigits(rub) & " (" & w & ")"
    СуммаПрописью = w & " " & Plural(rub, major) & " " & Right$("0" & CStr(cents), 2) & " " & Plural(cents, minor)
End Function

' Число словами: 1220 -> «одна тысяча двести двадцать». Тысячи — женского рода, остальное — мужского.
Private Function NumberWords(ByVal n As Variant) As String
    Dim scales As Variant, i As Integer, t As Long, s As String, part As String
    If n = 0 Then NumberWords = "ноль": Exit Function
    scales = Array(Array("", "", ""), Array("тысяча", "тысячи", "тысяч"), Array("миллион", "миллиона", "миллионов"), Array("миллиард", "миллиарда", "миллиардов"))
    For i = 0 To 3
        t = CLng(n - Int(n / 1000) * 1000)
        n = Int(n / 1000)
        If t > 0 Then
            part = Triad(t, i = 1)
            If i > 0 Then part = part & " " & Plural(t, scales(i))
            If s = "" Then s = part Else s = part & " " & s
        End If
    Next i
    NumberWords = s
End Function

' 1–999 словами; fem — «одна», «две» (для тысяч).
Private Function Triad(ByVal n As Long, ByVal fem As Boolean) As String
    Dim hundreds As Variant, tens As Variant, teens As Variant, units As Variant, s As String, rest As Long
    hundreds = Array("", "сто", "двести", "триста", "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", "девятьсот")
    tens = Array("", "", "двадцать", "тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", "девяносто")
    teens = Array("десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать")
    If fem Then
        units = Array("", "одна", "две", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять")
    Else
        units = Array("", "один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять")
    End If
    rest = n Mod 100
    AddWord s, hundreds(n \ 100)
    If rest >= 10 And rest < 20 Then
        AddWord s, teens(rest - 10)
    Else
        AddWord s, tens(rest \ 10)
        AddWord s, units(rest Mod 10)
    End If
    Triad = s
End Function

Private Sub AddWord(ByRef s As String, ByVal w As String)
    If w = "" Then Exit Sub
    If s = "" Then s = w Else s = s & " " & w
End Sub

' Форма слова при числе: 1 рубль, 2 рубля, 5 рублей, 11 рублей, 21 рубль.
Private Function Plural(ByVal n As Variant, forms As Variant) As String
    Dim n100 As Long, n10 As Long
    n100 = CLng(n - Int(n / 100) * 100)
    n10 = n100 Mod 10
    If n100 > 10 And n100 < 20 Then
        Plural = forms(2)
    ElseIf n10 = 1 Then
        Plural = forms(0)
    ElseIf n10 >= 2 And n10 <= 4 Then
        Plural = forms(1)
    Else
        Plural = forms(2)
    End If
End Function

' 1220000 -> «1 220 000»
Private Function GroupDigits(ByVal n As Variant) As String
    Dim s As String, r As String
    s = CStr(n)
    Do While Len(s) > 3
        r = " " & Right$(s, 3) & r
        s = Left$(s, Len(s) - 3)
    Loop
    GroupDigits = s & r
End Function