Надстройка «Сумма прописью» для Excel: скачать бесплатно

' =============================================================================
'  Сумма прописью — бесплатная надстройка для Excel от AllContract.ru
'  https://allcontract.ru/articles/nadstroyka-summa-propisyu-dlya-excel
'  Версия 1.0, сентябрь 2026
'
'  =СуммаПрописью(Число; [Формат]; [Валюта]; [НДС]; [РежимНДС]; [Падеж]; [Язык])
'
'  Формат    "прописью" (по умолчанию), "для договора", "всё прописью"
'  Валюта    "руб" (по умолчанию), "доллары", "евро", "юани", "тенге",
'            "белорусские рубли" или коды RUB, USD, EUR, CNY, KZT, BYN
'  НДС       ставка в процентах: 22, 10, 7, 5, 0 или "без НДС";
'            не указана — строки про НДС нет
'  РежимНДС  "в том числе" (по умолчанию) или "сверх того"
'  Падеж     "именительный" (по умолчанию), "родительный", "дательный",
'            "винительный", "творительный", "предложный"
'  Язык      "ru" (по умолчанию) или "en"
'
'  Надстройка только переводит число в текст: ничего не отправляет
'  в интернет, не читает и не меняет другие файлы.
' =============================================================================
Option Explicit

' Сумма от триллиона и больше не поддерживается.
Private Const MAX_INTEGER As Double = 1000000000000#

Public Function СуммаПрописью(Число As Variant, Optional Формат As Variant, _
        Optional Валюта As Variant, Optional НДС As Variant, Optional РежимНДС As Variant, _
        Optional Падеж As Variant, Optional Язык As Variant) As Variant
    Dim v As Variant, fmt As Integer, cur As String, rate As Variant
    Dim onTop As Integer, gc As Integer, lang As Integer
    Dim negative As Boolean, major As Double, minor As Long, result As Variant

    ' Ссылка на ячейку превращается в её значение, диапазон — в массив.
    v = Число
    If IsError(v) Then СуммаПрописью = v: Exit Function
    If IsArray(v) Then СуммаПрописью = CVErr(xlErrValue): Exit Function
    If IsEmpty(v) Then СуммаПрописью = "": Exit Function
    If VarType(v) = vbString Then
        If Trim$(v) = "" Then СуммаПрописью = "": Exit Function
    End If

    fmt = ParseFormat(OptText(Формат))
    cur = ParseCurrency(OptText(Валюта))
    rate = ParseRate(OptText(НДС))
    onTop = ParseVatMode(OptText(РежимНДС))
    gc = ParseCase(OptText(Падеж))
    lang = ParseLanguage(OptText(Язык))
    If fmt < 0 Or cur = "" Or IsError(rate) Or onTop < 0 Or gc < 0 Or lang < 0 Then
        СуммаПрописью = CVErr(xlErrValue): Exit Function
    End If

    result = ParseAmount(v, negative, major, minor)
    If IsError(result) Then СуммаПрописью = result: Exit Function

    result = MoneyText(negative, major, minor, fmt, cur, gc, lang = 1)
    If Not IsEmpty(rate) And Not negative Then
        v = VatText(major + minor / 100, rate, onTop = 1, fmt, cur, lang = 1)
        If IsError(v) Then СуммаПрописью = v: Exit Function
        result = result & v
    End If
    СуммаПрописью = result
End Function

' -----------------------------------------------------------------------------
'  Разбор числа: копейки округляются до двух знаков по правилам арифметики
' -----------------------------------------------------------------------------

Private Function ParseAmount(ByVal v As Variant, ByRef negative As Boolean, _
        ByRef major As Double, ByRef minor As Long) As Variant
    Dim s As String, i As Long, ch As String, intPart As String, fracPart As String
    Dim inFraction As Boolean, padded As String

    If VarType(v) = vbBoolean Then ParseAmount = CVErr(xlErrValue): Exit Function
    If IsNumeric(v) And VarType(v) <> vbString Then
        If Abs(v) >= MAX_INTEGER Then ParseAmount = CVErr(xlErrNum): Exit Function
        s = CStr(CDec(v))
    Else
        s = CStr(v)
    End If

    ' Пробелы — разделители разрядов, запятая или точка — десятичный знак.
    s = Replace(Replace(Replace(s, " ", ""), ChrW(160), ""), ChrW(8239), "")
    s = Replace(Replace(s, ChrW(8722), "-"), ChrW(8211), "-")
    negative = Left$(s, 1) = "-"
    If negative Then s = Mid$(s, 2)
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        If ch Like "#" Then
            If inFraction Then fracPart = fracPart & ch Else intPart = intPart & ch
        ElseIf (ch = "," Or ch = ".") And Not inFraction Then
            inFraction = True
        Else
            ParseAmount = CVErr(xlErrValue): Exit Function
        End If
    Next
    If intPart = "" And fracPart = "" Then ParseAmount = CVErr(xlErrValue): Exit Function

    Do While Len(intPart) > 1 And Left$(intPart, 1) = "0"
        intPart = Mid$(intPart, 2)
    Loop
    If Len(intPart) > 12 Then ParseAmount = CVErr(xlErrNum): Exit Function
    major = Val(intPart)

    padded = Left$(fracPart & "000", 3)
    minor = CLng(Left$(padded, 2))
    If Right$(padded, 1) >= "5" Then minor = minor + 1
    If minor = 100 Then minor = 0: major = major + 1
    If major >= MAX_INTEGER Then ParseAmount = CVErr(xlErrNum): Exit Function

    ' «Минус ноль» не пишем.
    negative = negative And (major + minor > 0)
    ParseAmount = True
End Function

' -----------------------------------------------------------------------------
'  Текст суммы
' -----------------------------------------------------------------------------

Private Function MoneyText(ByVal negative As Boolean, ByVal major As Double, _
        ByVal minor As Long, ByVal fmt As Integer, ByVal cur As String, _
        ByVal gc As Integer, ByVal english As Boolean) As String
    Dim words As String, majorUnit As String, minorNumber As String
    Dim minorUnit As String, digits As String, majorNoun As String, minorNoun As String

    If english Then
        words = WordsEn(major)
        If negative Then words = "minus " & words
        majorUnit = UnitEn(cur, False, major = 1)
        minorUnit = UnitEn(cur, True, minor = 1)
        If fmt = 3 Then minorNumber = WordsEn(minor) Else minorNumber = Format$(minor, "00")
        digits = GroupDigits(major, ",")
        If negative Then digits = "-" & digits
    Else
        majorNoun = CurrencyNoun(cur, False)
        minorNoun = CurrencyNoun(cur, True)
        words = WordsRu(major, NounGender(majorNoun), gc)
        If negative Then words = "минус " & words
        majorUnit = CountedForm(majorNoun, LastTriad(major), gc)
        minorUnit = CountedForm(minorNoun, minor, gc)
        If fmt = 3 Then
            minorNumber = WordsRu(minor, NounGender(minorNoun), gc)
        Else
            minorNumber = Format$(minor, "00")
        End If
        digits = GroupDigits(major, " ")
        If negative Then digits = ChrW(8722) & digits
    End If
    words = UCase$(Left$(words, 1)) & Mid$(words, 2)

    If fmt = 2 Then
        MoneyText = digits & " (" & words & ") " & majorUnit & " " & minorNumber & " " & minorUnit
    Else
        MoneyText = words & " " & majorUnit & " " & minorNumber & " " & minorUnit
    End If
End Function

' Строка про НДС. Суммы после тире всегда в именительном падеже.
Private Function VatText(ByVal amount As Double, ByVal rate As Variant, ByVal onTop As Boolean, _
        ByVal fmt As Integer, ByVal cur As String, ByVal english As Boolean) As Variant
    Dim nds As Double, total As Double, rateText As String, ndsText As String, totalText As String

    If VarType(rate) = vbString Then
        If english Then VatText = ", VAT not applicable" Else VatText = ", без НДС"
        Exit Function
    End If

    If rate = 0 Then
        nds = 0: total = amount
    ElseIf onTop Then
        nds = RoundHalfUp(amount * rate / 100 * 100) / 100
        total = RoundHalfUp((amount + nds) * 100) / 100
        If total >= MAX_INTEGER Then VatText = CVErr(xlErrNum): Exit Function
    Else
        nds = RoundHalfUp(amount * rate / (100 + rate) * 100) / 100
        total = amount
    End If

    rateText = Trim$(Str$(rate))
    If Not english Then rateText = Replace(rateText, ".", ",")
    ndsText = MoneyFromNumber(nds, fmt, cur, english)

    If Not onTop Then
        If english Then
            VatText = ", including VAT " & rateText & "%: " & ndsText
        Else
            VatText = ", в том числе НДС " & rateText & "% — " & ndsText
        End If
    Else
        totalText = MoneyFromNumber(total, fmt, cur, english)
        If english Then
            VatText = ", plus VAT " & rateText & "%: " & ndsText & ", total including VAT: " & totalText
        Else
            VatText = ", сверх того НДС " & rateText & "% — " & ndsText & ", всего с НДС — " & totalText
        End If
    End If
End Function

Private Function MoneyFromNumber(ByVal value As Double, ByVal fmt As Integer, _
        ByVal cur As String, ByVal english As Boolean) As String
    Dim cents As Double, major As Double
    cents = RoundHalfUp(Abs(value) * 100)
    major = Int(cents / 100)
    MoneyFromNumber = MoneyText(False, major, CLng(cents - major * 100), fmt, cur, 0, english)
End Function

' Округление «половина — вверх», как в калькуляторе на сайте.
' Встроенный Round в VBA округляет 0,5 до чётного, он здесь не подходит.
Private Function RoundHalfUp(ByVal x As Double) As Double
    RoundHalfUp = Int(x + 0.5)
End Function

Private Function LastTriad(ByVal n As Double) As Long
    LastTriad = CLng(n - Int(n / 1000) * 1000)
End Function

' 1234567 -> "1 234 567"
Private Function GroupDigits(ByVal n As Double, ByVal separator As String) As String
    Dim s As String, result As String
    s = Format$(n, "0")
    Do While Len(s) > 3
        result = separator & Right$(s, 3) & result
        s = Left$(s, Len(s) - 3)
    Loop
    GroupDigits = s & result
End Function

' -----------------------------------------------------------------------------
'  Числительные по-русски, во всех падежах
'  Формы перечислены через запятую в порядке: И, Р, Д, В, Т, П
' -----------------------------------------------------------------------------

Private Function WordsRu(ByVal n As Double, ByVal gender As String, ByVal gc As Integer) As String
    Dim triads(3) As Long, i As Integer, rest As Double, s As String, t As Long

    If n = 0 Then WordsRu = Pick("ноль,ноля,нолю,ноль,нолём,ноле", gc): Exit Function
    rest = n
    For i = 0 To 3
        triads(i) = CLng(rest - Int(rest / 1000) * 1000)
        rest = Int(rest / 1000)
    Next
    For i = 3 To 0 Step -1
        t = triads(i)
        If t > 0 Then
            If i = 0 Then
                s = s & " " & TriadRu(t, gender, gc)
            Else
                s = s & " " & TriadRu(t, NounGender(ScaleNoun(i)), gc) & " " & _
                    CountedForm(ScaleNoun(i), t, gc)
            End If
        End If
    Next
    WordsRu = Mid$(s, 2)
End Function

Private Function TriadRu(ByVal n As Long, ByVal gender As String, ByVal gc As Integer) As String
    Dim h As Long, t As Long, u As Long, s As String

    h = n \ 100
    t = (n Mod 100) \ 10
    u = n Mod 10
    If h > 0 Then s = s & " " & Pick(Hundreds(h), gc)
    If t = 1 Then
        s = s & " " & Pick(Teens(u), gc)
    Else
        If t > 1 Then s = s & " " & Pick(Tens(t), gc)
        If u > 0 Then s = s & " " & Pick(Units(u, gender), gc)
    End If
    TriadRu = Mid$(s, 2)
End Function

Private Function Units(ByVal u As Long, ByVal gender As String) As String
    Select Case u
        Case 1
            Select Case gender
                Case "f": Units = "одна,одной,одной,одну,одной,одной"
                Case "n": Units = "одно,одного,одному,одно,одним,одном"
                Case Else: Units = "один,одного,одному,один,одним,одном"
            End Select
        Case 2
            If gender = "f" Then
                Units = "две,двух,двум,две,двумя,двух"
            Else
                Units = "два,двух,двум,два,двумя,двух"
            End If
        Case 3: Units = "три,трёх,трём,три,тремя,трёх"
        Case 4: Units = "четыре,четырёх,четырём,четыре,четырьмя,четырёх"
        Case 5: Units = "пять,пяти,пяти,пять,пятью,пяти"
        Case 6: Units = "шесть,шести,шести,шесть,шестью,шести"
        Case 7: Units = "семь,семи,семи,семь,семью,семи"
        Case 8: Units = "восемь,восьми,восьми,восемь,восемью,восьми"
        Case 9: Units = "девять,девяти,девяти,девять,девятью,девяти"
    End Select
End Function

Private Function Teens(ByVal u As Long) As String
    Dim nom As String, stem As String
    nom = Choose(u + 1, "десять", "одиннадцать", "двенадцать", "тринадцать", _
        "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", _
        "восемнадцать", "девятнадцать")
    stem = Left$(nom, Len(nom) - 1)
    Teens = nom & "," & stem & "и," & stem & "и," & nom & "," & stem & "ью," & stem & "и"
End Function

Private Function Tens(ByVal t As Long) As String
    Select Case t
        Case 2: Tens = "двадцать,двадцати,двадцати,двадцать,двадцатью,двадцати"
        Case 3: Tens = "тридцать,тридцати,тридцати,тридцать,тридцатью,тридцати"
        Case 4: Tens = "сорок,сорока,сорока,сорок,сорока,сорока"
        Case 5: Tens = "пятьдесят,пятидесяти,пятидесяти,пятьдесят,пятьюдесятью,пятидесяти"
        Case 6: Tens = "шестьдесят,шестидесяти,шестидесяти,шестьдесят,шестьюдесятью,шестидесяти"
        Case 7: Tens = "семьдесят,семидесяти,семидесяти,семьдесят,семьюдесятью,семидесяти"
        Case 8: Tens = "восемьдесят,восьмидесяти,восьмидесяти,восемьдесят,восемьюдесятью,восьмидесяти"
        Case 9: Tens = "девяносто,девяноста,девяноста,девяносто,девяноста,девяноста"
    End Select
End Function

Private Function Hundreds(ByVal h As Long) As String
    Select Case h
        Case 1: Hundreds = "сто,ста,ста,сто,ста,ста"
        Case 2: Hundreds = "двести,двухсот,двумстам,двести,двумястами,двухстах"
        Case 3: Hundreds = "триста,трёхсот,трёмстам,триста,тремястами,трёхстах"
        Case 4: Hundreds = "четыреста,четырёхсот,четырёмстам,четыреста,четырьмястами,четырёхстах"
        Case 5: Hundreds = "пятьсот,пятисот,пятистам,пятьсот,пятьюстами,пятистах"
        Case 6: Hundreds = "шестьсот,шестисот,шестистам,шестьсот,шестьюстами,шестистах"
        Case 7: Hundreds = "семьсот,семисот,семистам,семьсот,семьюстами,семистах"
        Case 8: Hundreds = "восемьсот,восьмисот,восьмистам,восемьсот,восемьюстами,восьмистах"
        Case 9: Hundreds = "девятьсот,девятисот,девятистам,девятьсот,девятьюстами,девятистах"
    End Select
End Function

' -----------------------------------------------------------------------------
'  Существительные: "род|единственное число|множественное|после 2–4"
' -----------------------------------------------------------------------------

Private Function ScaleNoun(ByVal i As Integer) As String
    Select Case i
        Case 1: ScaleNoun = "f|тысяча,тысячи,тысяче,тысячу,тысячей,тысяче|" & _
            "тысячи,тысяч,тысячам,тысячи,тысячами,тысячах|тысячи"
        Case 2: ScaleNoun = "m|миллион,миллиона,миллиону,миллион,миллионом,миллионе|" & _
            "миллионы,миллионов,миллионам,миллионы,миллионами,миллионах|миллиона"
        Case 3: ScaleNoun = "m|миллиард,миллиарда,миллиарду,миллиард,миллиардом,миллиарде|" & _
            "миллиарды,миллиардов,миллиардам,миллиарды,миллиардами,миллиардах|миллиарда"
    End Select
End Function

Private Function CurrencyNoun(ByVal cur As String, ByVal minorUnit As Boolean) As String
    Const KOPECK As String = "f|копейка,копейки,копейке,копейку,копейкой,копейке|" & _
        "копейки,копеек,копейкам,копейки,копейками,копейках|копейки"
    Const CENT As String = "m|цент,цента,центу,цент,центом,центе|" & _
        "центы,центов,центам,центы,центами,центах|цента"

    If minorUnit Then
        Select Case cur
            Case "USD", "EUR": CurrencyNoun = CENT
            Case "CNY": CurrencyNoun = "m|фэнь,фэня,фэню,фэнь,фэнем,фэне|" & _
                "фэни,фэней,фэням,фэни,фэнями,фэнях|фэня"
            Case "KZT": CurrencyNoun = "m|тиын,тиына,тиыну,тиын,тиыном,тиыне|" & _
                "тиыны,тиынов,тиынам,тиыны,тиынами,тиынах|тиына"
            Case Else: CurrencyNoun = KOPECK
        End Select
        Exit Function
    End If

    Select Case cur
        Case "USD": CurrencyNoun = "m|доллар США,доллара США,доллару США,доллар США," & _
            "долларом США,долларе США|доллары США,долларов США,долларам США," & _
            "доллары США,долларами США,долларах США|доллара США"
        Case "EUR": CurrencyNoun = "m|евро,евро,евро,евро,евро,евро|евро,евро,евро,евро,евро,евро|евро"
        Case "CNY": CurrencyNoun = "m|юань,юаня,юаню,юань,юанем,юане|" & _
            "юани,юаней,юаням,юани,юанями,юанях|юаня"
        Case "KZT": CurrencyNoun = "m|тенге,тенге,тенге,тенге,тенге,тенге|" & _
            "тенге,тенге,тенге,тенге,тенге,тенге|тенге"
        Case "BYN": CurrencyNoun = "m|белорусский рубль,белорусского рубля,белорусскому рублю," & _
            "белорусский рубль,белорусским рублём,белорусском рубле|белорусские рубли," & _
            "белорусских рублей,белорусским рублям,белорусские рубли,белорусскими рублями," & _
            "белорусских рублях|белорусских рубля"
        Case Else: CurrencyNoun = "m|рубль,рубля,рублю,рубль,рублём,рубле|" & _
            "рубли,рублей,рублям,рубли,рублями,рублях|рубля"
    End Select
End Function

Private Function NounGender(ByVal noun As String) As String
    NounGender = Left$(noun, 1)
End Function

' Форма существительного после числа n: «один рубль», «два рубля», «пять рублей»,
' в косвенных падежах — «двумя рублями», «пятью рублями».
Private Function CountedForm(ByVal noun As String, ByVal n As Long, ByVal gc As Integer) As String
    Dim p As Variant, lastTwo As Long, lastOne As Long, teen As Boolean

    p = Split(noun, "|")
    lastTwo = n Mod 100
    lastOne = n Mod 10
    teen = lastTwo >= 11 And lastTwo <= 19

    If n = 0 Then
        CountedForm = Pick(p(2), 1)
    ElseIf lastOne = 1 And Not teen Then
        CountedForm = Pick(p(1), gc)
    ElseIf gc = 0 Or gc = 3 Then
        If lastOne >= 2 And lastOne <= 4 And Not teen Then
            CountedForm = p(3)
        Else
            CountedForm = Pick(p(2), 1)
        End If
    Else
        CountedForm = Pick(p(2), gc)
    End If
End Function

Private Function Pick(ByVal forms As String, ByVal gc As Integer) As String
    Pick = Split(forms, ",")(gc)
End Function

' -----------------------------------------------------------------------------
'  Английский вариант
' -----------------------------------------------------------------------------

Private Function WordsEn(ByVal n As Double) As String
    Dim rest As Double, t As Long, scaleIndex As Integer, s As String, w As String

    If n = 0 Then WordsEn = "zero": Exit Function
    rest = n
    Do While rest > 0
        t = CLng(rest - Int(rest / 1000) * 1000)
        If t > 0 Then
            w = TriadEn(t)
            If scaleIndex > 0 Then w = w & " " & Choose(scaleIndex, "thousand", "million", "billion")
            If s = "" Then s = w Else s = w & " " & s
        End If
        rest = Int(rest / 1000)
        scaleIndex = scaleIndex + 1
    Loop
    WordsEn = s
End Function

Private Function TriadEn(ByVal n As Long) As String
    Dim unitWords As Variant, tensWords As Variant, h As Long, rest As Long, s As String

    unitWords = Split(",one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve," & _
        "thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen", ",")
    tensWords = Split(",,twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety", ",")
    h = n \ 100
    rest = n Mod 100
    If h > 0 Then s = unitWords(h) & " hundred"
    If rest > 0 And rest < 20 Then
        s = s & " " & unitWords(rest)
    ElseIf rest >= 20 Then
        s = s & " " & tensWords(rest \ 10)
        If rest Mod 10 > 0 Then s = s & "-" & unitWords(rest Mod 10)
    End If
    TriadEn = Trim$(s)
End Function

Private Function UnitEn(ByVal cur As String, ByVal minorUnit As Boolean, ByVal one As Boolean) As String
    Dim names As Variant
    Select Case cur
        Case "USD": names = Array("US dollar", "US dollars", "cent", "cents")
        Case "EUR": names = Array("euro", "euros", "cent", "cents")
        Case "CNY": names = Array("yuan", "yuan", "fen", "fen")
        Case "KZT": names = Array("tenge", "tenge", "tiyn", "tiyn")
        Case "BYN": names = Array("Belarusian ruble", "Belarusian rubles", "kopeck", "kopecks")
        Case Else: names = Array("ruble", "rubles", "kopeck", "kopecks")
    End Select
    UnitEn = names(IIf(minorUnit, 2, 0) + IIf(one, 0, 1))
End Function

' -----------------------------------------------------------------------------
'  Разбор параметров. Неизвестное значение — ошибка #ЗНАЧ!
' -----------------------------------------------------------------------------

Private Function OptText(ByRef v As Variant) As String
    Dim x As Variant
    If IsMissing(v) Then Exit Function
    x = v
    If IsError(x) Or IsArray(x) Then OptText = "#": Exit Function
    If IsEmpty(x) Then Exit Function
    OptText = Replace(LCase$(Trim$(CStr(x))), "ё", "е")
End Function

' 1 — прописью, 2 — для договора, 3 — всё прописью; -1 — ошибка.
Private Function ParseFormat(ByVal s As String) As Integer
    Select Case True
        Case s = "", s = "прописью", s = "words", s = "1": ParseFormat = 1
        Case s Like "*договор*", s = "contract", s = "2": ParseFormat = 2
        Case s Like "вс* прописью", s = "полностью", s = "full", s = "3": ParseFormat = 3
        Case Else: ParseFormat = -1
    End Select
End Function

Private Function ParseCurrency(ByVal s As String) As String
    s = Replace(s, ".", "")
    Select Case True
        Case s = "", s = "rub", s = "rur", s = "р", s = ChrW(&H20BD), s Like "руб*"
            ParseCurrency = "RUB"
        Case s = "byn", s = "byr", s = "br", s Like "бел*"
            ParseCurrency = "BYN"
        Case s = "usd", s = "$", s Like "долл*"
            ParseCurrency = "USD"
        Case s = "eur", s = ChrW(&H20AC), s = "евро"
            ParseCurrency = "EUR"
        Case s = "cny", s = "rmb", s = ChrW(&HA5), s Like "юан*"
            ParseCurrency = "CNY"
        Case s = "kzt", s = ChrW(&H20B8), s = "тенге"
            ParseCurrency = "KZT"
    End Select
End Function

' Пусто — строки НДС нет; "none" — «без НДС»; число — ставка в процентах.
Private Function ParseRate(ByVal s As String) As Variant
    Dim digits As String, rate As Double

    If s = "" Then Exit Function
    If s Like "без*" Or s = "нет" Or s = "none" Or s = "-" Then ParseRate = "none": Exit Function

    digits = Replace(Replace(Replace(s, "%", ""), " ", ""), ",", ".")
    If digits = "" Or digits Like "*[!0-9.]*" Or digits Like "*.*.*" Then
        ParseRate = CVErr(xlErrValue): Exit Function
    End If
    rate = Val(digits)
    ' Ячейка в процентном формате передаёт 22% как 0,22.
    If rate > 0 And rate < 1 Then rate = Round(rate * 100, 6)
    If rate >= 100 Then ParseRate = CVErr(xlErrValue): Exit Function
    ParseRate = rate
End Function

' 0 — в том числе, 1 — сверх того; -1 — ошибка.
Private Function ParseVatMode(ByVal s As String) As Integer
    Select Case True
        Case s = "", s Like "*том числе*", s Like "вкл*", s = "included", s = "1"
            ParseVatMode = 0
        Case s Like "сверх*", s Like "начисл*", s = "плюс", s = "on-top", s = "2"
            ParseVatMode = 1
        Case Else
            ParseVatMode = -1
    End Select
End Function

' 0…5 — именительный … предложный; -1 — ошибка.
Private Function ParseCase(ByVal s As String) As Integer
    Select Case True
        Case s = "", s = "и", s Like "им*", s = "nom", s = "1": ParseCase = 0
        Case s = "р", s Like "род*", s = "gen", s = "2": ParseCase = 1
        Case s = "д", s Like "дат*", s = "dat", s = "3": ParseCase = 2
        Case s = "в", s Like "вин*", s = "acc", s = "4": ParseCase = 3
        Case s = "т", s Like "тв*", s = "ins", s = "5": ParseCase = 4
        Case s = "п", s Like "пред*", s = "pre", s = "6": ParseCase = 5
        Case Else: ParseCase = -1
    End Select
End Function

' 0 — русский, 1 — английский; -1 — ошибка.
Private Function ParseLanguage(ByVal s As String) As Integer
    Select Case True
        Case s = "", s = "ru", s Like "рус*": ParseLanguage = 0
        Case s = "en", s Like "eng*", s Like "англ*": ParseLanguage = 1
        Case Else: ParseLanguage = -1
    End Select
End Function

' Подсказки к функции в мастере функций Excel (fx). На работу функции не влияют.
Private Sub Workbook_Open()
    On Error Resume Next
    Application.MacroOptions Macro:="СуммаПрописью", _
        Description:="Сумма прописью для документов: рубли и копейки, формат для договора, " & _
            "НДС, валюты, падежи. Бесплатная надстройка AllContract.ru", _
        Category:=7, _
        ArgumentDescriptions:=Array( _
            "Сумма цифрами или ссылка на ячейку", _
            """прописью"" (по умолчанию), ""для договора"" или ""всё прописью""", _
            """руб"" (по умолчанию), ""доллары"", ""евро"", ""юани"", ""тенге"", ""белорусские рубли""", _
            "Ставка НДС: 22, 10, 7, 5, 0 или ""без НДС"". Пусто — без строки НДС", _
            """в том числе"" (по умолчанию) или ""сверх того""", _
            """именительный"" (по умолчанию), ""родительный"", ""дательный"", ""винительный"", ""творительный"", ""предложный""", _
            """ru"" (по умолчанию) или ""en""")
End Sub