Function ЧИСЛИТ(число As Double, Optional текст As String = "RUB", Optional дробная_часть As Integer = 0) As String
'
Dim DROB As String           ' Дробная часть входящего значения
Dim DROBCHIS As String       ' текст дробной части
Dim CHISLITELNOE As String   ' Результирующее числительное (текст)
Dim CELOE As String          ' Целая часть входящего значения (текст)
Dim CHAST As String
Dim clValuta As String
Dim drVALUTA As String
Dim n() As String            ' Отдельная цифра целой части входящего значения (текст)
Dim CIFRA() As String        ' Отдельное числительное (текст)
Dim RAZRJAD() As String      ' Наименование разряда числа (текст)
'
If Sgn(число) = -1 Then число = Abs(число) ' Если значение отрицательное обрабатывается его абсолютное значение

CELOE = Trim$(Str(Fix(число + 0.0001))) ' Удаление пробелов и отбрасывание дробной части
DROB = Round((число - Val(CELOE)) + 0.0001, 2) * 100 ' Дробная часть
If Len(DROB) = 1 Then DROB = "0" & DROB

ReDim n(Len(CELOE)) As String        ' Определение размерности массивов
ReDim CIFRA(Len(CELOE)) As String
ReDim RAZRJAD(Len(CELOE)) As String

CHISLITELNOE = vbNullString
DROBCHIS = vbNullString

CHAST = CELOE
For i = 1 To Len(CELOE)      ' Основной блок процедуры
    n(i) = Mid$(CELOE, Len(CELOE) - i + 1, 1)
    
    GoSub EdinizyIdesyatki
    
    If i = 3 Or i = 6 Or i = 9 Or i = 12 Then
'       Сотни
        If n(i) = "0" Then CIFRA(i) = vbNullString
        If n(i) = "1" Then CIFRA(i) = "сто "
        If n(i) = "2" Then CIFRA(i) = "двести "
        If n(i) = "3" Then CIFRA(i) = "триста "
        If n(i) = "4" Then CIFRA(i) = "четыреста "
        If n(i) = "5" Then CIFRA(i) = "пятьсот "
        If n(i) = "6" Then CIFRA(i) = "шестьсот "
        If n(i) = "7" Then CIFRA(i) = "семьсот "
        If n(i) = "8" Then CIFRA(i) = "восемьсот "
        If n(i) = "9" Then CIFRA(i) = "девятьсот "
    End If
'       Разряды
            ' Тысячи
    If i = 4 Then
        If Val(n(i)) = 0 Or Val(n(i)) > 4 Then RAZRJAD(i) = "тысяч "
        If Val(n(i)) = 1 Then RAZRJAD(i) = "тысяча "
        If Val(n(i)) >= 2 And Val(n(i)) <= 4 Then RAZRJAD(i) = "тысячи "
    End If
    If i = 5 Then
        If Val(n(i)) = 1 Then RAZRJAD(i - 1) = "тысяч "
    End If
    If i = 6 Then
        If Val(n(i)) = 0 And Val(n(i - 1)) = 0 And Val(n(i - 2)) = 0 Then RAZRJAD(i - 2) = vbNullString
    End If
            ' Миллионы
    If i = 7 Then
        If Val(n(i)) = 0 Or Val(n(i)) > 4 Then RAZRJAD(i) = "миллионов "
        If Val(n(i)) = 1 Then RAZRJAD(i) = "миллион "
        If Val(n(i)) >= 2 And Val(n(i)) <= 4 Then RAZRJAD(i) = "миллиона "
    End If
    If i = 8 Then
        If Val(n(i)) = 1 Then RAZRJAD(i - 1) = "миллионов "
    End If
    If i = 9 Then
        If Val(n(i)) = 0 And Val(n(i - 1)) = 0 And Val(n(i - 2)) = 0 Then RAZRJAD(i - 2) = vbNullString
    End If
            ' Миллиарды
     If i = 10 Then
        If Val(n(i)) = 0 Or Val(n(i)) > 4 Then RAZRJAD(i) = "миллиардов "
        If Val(n(i)) = 1 Then RAZRJAD(i) = "миллиард "
        If Val(n(i)) >= 2 And Val(n(i)) <= 4 Then RAZRJAD(i) = "миллиарда "
    End If
    If i = 11 Then
        If Val(n(i)) = 1 Then RAZRJAD(i - 1) = "миллиардов "
    End If
' При необходимости преобразования бОльших чисел - активизировать следующую часть кода,
' вставить блок разрядов (например "Триллионы") и отредактировать его в соответствии с новым разрядом
    ' If I = 12 Then
    '    If Val(N(I)) = 0 And Val(N(I - 1)) = 0 And Val(N(I - 2)) = 0 Then RAZRJAD(I - 2) = vbNullString
    ' End If
                       
Next i

For i = 1 To Len(CELOE) ' Формирование числительного
    CHISLITELNOE = CIFRA(i) & RAZRJAD(i) & CHISLITELNOE
Next i
    Mid$(CHISLITELNOE, 1, 1) = StrConv(Left$(CHISLITELNOE, 1), vbProperCase)


ReDim n(Len(DROB)) As String       ' переопределение размерности массивов
ReDim CIFRA(Len(DROB)) As String

CHAST = DROB

For i = 1 To Len(DROB)     ' преобразование дробной части
    n(i) = Mid$(DROB, Len(DROB) - i + 1, 1)
    GoSub EdinizyIdesyatki
Next i
    
For i = 1 To Len(DROB) ' Формирование дробной части числительного
    DROBCHIS = CIFRA(i) & Trim$(DROBCHIS)
Next i

If дробная_часть = 0 Then DROBOR = DROB Else DROBOR = Trim$(DROBCHIS)

' Наименование валюты
If текст = "USD" Then
    clValuta = "долл.США "  'Принеобходимости применения полного наименования валюты необходимо
                            'закомментировать текущую строку и активировать следующие четыре
    
    'If Val(Right$(CELOE, 1)) = 0 Or Val(Right$(CELOE, 1)) > 4 Then clValuta = "долларов США "
    'If Val(Right$(CELOE, 1)) = 1 Then clValuta = "доллар США "
    'If Val(Right$(CELOE, 1)) >= 2 And Val(Right$(CELOE, 1)) <= 4 Then clValuta = "доллара США "
    'If Val(Right$(CELOE, 2)) >= 10 And Val(Right$(CELOE, 2)) <= 19 Then clValuta = "долларов США "
    
    If Val(Right$(DROB, 1)) = 0 Or Val(Right$(DROB, 1)) > 4 Then drVALUTA = " центов."
    If Val(Right$(DROB, 1)) = 1 Then drVALUTA = " цент."
    If Val(Right$(DROB, 1)) >= 2 And Val(Right$(DROB, 1)) <= 4 Then drVALUTA = " цента."
    If Val(Right$(DROB, 2)) >= 10 And Val(Right$(DROB, 2)) <= 19 Then drVALUTA = " центов."
End If

If текст = "RUB" Then
'    clValuta = "руб. "      'Принеобходимости применения полного наименования валюты необходимо
                            'закомментировать текущую строку и активировать следующие четыре
    
    If Val(Right$(CELOE, 1)) = 0 Or Val(Right$(CELOE, 1)) > 4 Then clValuta = "рублей "
    If Val(Right$(CELOE, 1)) = 1 Then clValuta = "рубль "
    If Val(Right$(CELOE, 1)) >= 2 And Val(Right$(CELOE, 1)) <= 4 Then clValuta = "рубля "
    If Val(Right$(CELOE, 2)) >= 10 And Val(Right$(CELOE, 2)) <= 19 Then clValuta = "рублей "
        
        If DROBOR <> DROB Then
            If Right$(DROBOR, 4) = "один" Then Mid$(DROBOR, InStrRev(DROBOR, " ") + 1, 4) = "одна"
            If Right$(DROBOR, 3) = "два" Then Mid$(DROBOR, InStrRev(DROBOR, " ") + 1, 3) = "две"
        End If
                
    If Val(Right$(DROB, 1)) = 0 Or Val(Right$(DROB, 1)) > 4 Then drVALUTA = " копеек"
    If Val(Right$(DROB, 1)) = 1 Then drVALUTA = " копейка"
    If Val(Right$(DROB, 1)) >= 2 And Val(Right$(DROB, 1)) <= 4 Then drVALUTA = " копейки"
    If Val(Right$(DROB, 2)) >= 10 And Val(Right$(DROB, 2)) <= 19 Then drVALUTA = " копеек"
End If

If текст = "EUR" Then
    clValuta = "евро "
    
    If Val(Right$(DROB, 1)) = 0 Or Val(Right$(DROB, 1)) > 4 Then drVALUTA = " центов."
    If Val(Right$(DROB, 1)) = 1 Then drVALUTA = " цент."
    If Val(Right$(DROB, 1)) >= 2 And Val(Right$(DROB, 1)) <= 4 Then drVALUTA = " цента."
    If Val(Right$(DROB, 2)) >= 10 And Val(Right$(DROB, 2)) <= 19 Then drVALUTA = " центов."
End If

ЧИСЛИТ = CHISLITELNOE & clValuta & DROBOR & drVALUTA
Exit Function

EdinizyIdesyatki:   'Подпрограмма обработки единиц и десятков
'       Единицы
    If i = 1 Or i = 4 Or i = 7 Or i = 10 Then
        If Len(CHAST) = 1 And n(i) = "0" Or CHAST = "00" Then CIFRA(i) = "ноль "
        If n(i) = "1" Then CIFRA(i) = "один "
            If i = 4 And n(i) = "1" Then CIFRA(i) = "одна "   ' единицы тысяч
        If n(i) = "2" Then CIFRA(i) = "два "
            If i = 4 And n(i) = "2" Then CIFRA(i) = "две "    ' единицы тысяч
        If n(i) = "3" Then CIFRA(i) = "три "
        If n(i) = "4" Then CIFRA(i) = "четыре "
        If n(i) = "5" Then CIFRA(i) = "пять "
        If n(i) = "6" Then CIFRA(i) = "шесть "
        If n(i) = "7" Then CIFRA(i) = "семь "
        If n(i) = "8" Then CIFRA(i) = "восемь "
        If n(i) = "9" Then CIFRA(i) = "девять "
    End If

'       Десятки
    If i = 2 Or i = 5 Or i = 8 Or i = 11 Then
        If n(i) = "0" Then CIFRA(i) = vbNullString
            
            If n(i) = "1" And n(i - 1) = "0" Then CIFRA(i - 1) = "десять "
            If n(i) = "1" And n(i - 1) = "1" Then CIFRA(i - 1) = "одиннадцать "
            If n(i) = "1" And n(i - 1) = "2" Then CIFRA(i - 1) = "двенадцать "
            If n(i) = "1" And n(i - 1) = "3" Then CIFRA(i - 1) = "тринадцать "
            If n(i) = "1" And n(i - 1) = "4" Then CIFRA(i - 1) = "четырнадцать "
            If n(i) = "1" And n(i - 1) = "5" Then CIFRA(i - 1) = "пятнадцать "
            If n(i) = "1" And n(i - 1) = "6" Then CIFRA(i - 1) = "шестнадцать "
            If n(i) = "1" And n(i - 1) = "7" Then CIFRA(i - 1) = "семнадцать "
            If n(i) = "1" And n(i - 1) = "8" Then CIFRA(i - 1) = "восемнадцать "
            If n(i) = "1" And n(i - 1) = "9" Then CIFRA(i - 1) = "девятнадцать "
            
        If n(i) = "2" Then CIFRA(i) = "двадцать "
        If n(i) = "3" Then CIFRA(i) = "тридцать "
        If n(i) = "4" Then CIFRA(i) = "сорок "
        If n(i) = "5" Then CIFRA(i) = "пятьдесят "
        If n(i) = "6" Then CIFRA(i) = "шестьдесят "
        If n(i) = "7" Then CIFRA(i) = "семьдесят "
        If n(i) = "8" Then CIFRA(i) = "восемьдесят "
        If n(i) = "9" Then CIFRA(i) = "девяносто "
    End If
Return

End Function