Макрос VBA перевод стоимости из чисел в строку

Программное обеспечение

Удобный макрос для VBA который переводит цифры в строку с рублями и копейками
Можно использовать в Word или Excel

Attribute VB_Name = "NumInWor"

Private Function TriadInWords$(Triad$, Gender%, Unit1$, Unit2$, Unit5$)
    Dim Result$
    If Triad = "000" Then
        TriadInWords = ""
    Else
        Result = Choose(Mid(Triad, 1, 1) + 1, "", " сто", " двести", " триста", " четыреста", _
            " пятьсот", " шестьсот", " семьсот", " восемьсот", " девятьсот")
        If Mid(Triad, 2, 1) = 1 Then
            Result = Result & " " & Choose(Mid(Triad, 3, 1) + 1, "десять", "одиннадцать", _
                "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
                "семнадцать", "восемнадцать", "девятнадцать") & " " & Unit5
        Else
            Result = Result & Choose(Mid(Triad, 2, 1) + 1, "", "", " двадцать", " тридцать", _
                " сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят", " девяносто")
            Select Case Mid(Triad, 3, 1)
                Case 1: Result = Result & Choose(Gender, " один ", " одна ", " одно ") & Unit1
                Case 2: Result = Result & Choose(Gender, " два ", " две ", " два ") & Unit2
                Case 3: Result = Result & " три " & Unit2
                Case 4: Result = Result & " четыре " & Unit2
                Case Else: Result = Result & Choose(Mid(Triad, 3, 1) + 1, "", "", "", "", "", _
                    " пять", " шесть", " семь", " восемь", " девять") & " " & Unit5
            End Select
        End If
        TriadInWords = Result
    End If
End Function
------------------------------------------------------------------------------------------------------------------------
Private Function NumberInWords(Number, Gender%, Unit1$, Unit2$, Unit5$)
    Dim Image$, Modulus$
    If IsNull(Number) Then
        NumberInWords = Null
    Else
        Image = Format(Abs(Number), String(15, "0"))
        If Image = 0 Then
            NumberInWords = Trim("00 " & Unit5)
        Else
            If Len(Image) > 15 Then
                Modulus = " <много> " & Unit5
            Else
                Modulus = TriadInWords(Mid(Image, 1, 3), 1, "триллион", "триллионa", "триллионов") & _
                    TriadInWords(Mid(Image, 4, 3), 1, "миллиард", "миллиарда", "миллиардов") & _
                    TriadInWords(Mid(Image, 7, 3), 1, "миллион", "миллиона", "миллионов") & _
                    TriadInWords(Mid(Image, 10, 3), 2, "тысяча", "тысячи", "тысяч") & _
                    IIf(Mid(Image, 13, 3) = "000", " " & Unit5, _
                        TriadInWords(Mid(Image, 13, 3), Gender, Unit1, Unit2, Unit5))
            End If
            NumberInWords = Trim(IIf(Number < 0, "минус", "") & Modulus)
        End If
    End If
End Function
------------------------------------------------------------------------------------------------------------------------
Private Function AmountInWords(Amount, Gender1%, Dollar1$, Dollar2$, Dollar5$, Gender2%, Cent1$, Cent2$, Cent5$)
    Dim Image$
    If IsNull(Amount) Then
        AmountInWords = Null
    Else
        
        Image = Format(Amount, "0.00")
        AmountInWords = IIf(Left(Image, 1) = "-", "минус ", "") & _
            NumberInWords(Abs(Left(Image, Len(Image) - 3)), Gender1, Dollar1, Dollar2, Dollar5) & ", " & NumberInWords(Right(Image, 2), Gender2, Cent1, Cent2, Cent5)
    End If
End Function
------------------------------------------------------------------------------------------------------------------------
Private Function IntegerInWords(Number)
    IntegerInWords = NumberInWords(Number, 1, "", "", "")
End Function
------------------------------------------------------------------------------------------------------------------------
Private Function RoublesInWords(Amount)
    RoublesInWords = AmountInWords(Amount, 1, "рубль", "рубл¤", "рублей", 2, "копейка", "копейки", "копеек")
End Function
------------------------------------------------------------------------------------------------------------------------
Public Function цифры_в_буквы(num As Double)
    цифры_в_буквы = IntegerInWords(num)
End Function
------------------------------------------------------------------------------------------------------------------------
Public Function цифры_в_рубли(rub As Double)
    Dim tmp
    Dim n
    Dim t
    Dim kop As String
    tmp = RoublesInWords(rub)
    If Mid(StrReverse(rub), 2, 1) = "," Then kop = Right(rub, 1) + "0" Else kop = Right(rub, 2)
    tmp = UCase(Left(tmp, 1)) + Right(tmp, Len(tmp) - 1)
    n = InStr(tmp, ",")
    t = Len(tmp) - InStrRev(tmp, " ")
    If InStr(tmp, "00") = 0 Then
        цифры_в_рубли = Left(tmp, n - 1) + " " + kop + " " + Right(tmp, t)
                            Else
        цифры_в_рубли = tmp
    End If
End Function