Option Compare Text

Function ЧислоПрописью(число As Double, Optional дробная_часть As Integer = 0) As String
'
Dim DROB           ' Дробная часть входящего значения
Dim DROBCHIS As String       ' текст дробной части
Dim CHISLITELNOE As String   ' Результирующее числительное (текст)
Dim CELOE          ' Целая часть входящего значения (текст)
Dim CHAST As String
Dim clValuta As String
Dim drValuta As String
Dim n() As String            ' Отдельная цифра целой части входящего значения (текст)
Dim CIFRA() As String        ' Отдельное числительное (текст)
Dim RAZRJAD() As String      ' Наименование разряда числа (текст)
Dim Znak$
'
If Sgn(число) = -1 Then
  число = Abs(число) ' Если значение отрицательное обрабатывается его абсолютное значение
  Znak = "минус "
End If
  
If Fix(число) = число Then
  число = число + 0.0001
End If
CELOE = Split(Trim$(CStr(число)), Application.DecimalSeparator)(0) ' Удаление пробелов и отбрасывание дробной части
DROB = Split(Trim$(CStr(число)), Application.DecimalSeparator)(1) ' Дробная часть
Select Case Len(DROB)
  Case Is < 3
    DROB = DROB & String(3 - Len(DROB), "0")
  Case Is > 3
    DROB = Left(DROB, 3)
End Select

ReDim n(1 To 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 ObrabotkaRazryadov
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(1 To 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 ObrabotkaRazryadov
Next I
    
For I = 1 To Len(DROB) ' Формирование дробной части числительного
    DROBCHIS = CIFRA(I) & Trim$(DROBCHIS)
Next I

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

clValuta = IIf(clValuta = "", "целых ", clValuta)
drValuta = IIf(drValuta = "", " тысячных", drValuta)

ЧислоПрописью = Znak & CHISLITELNOE & clValuta & DROBOR & drValuta
Exit Function

ObrabotkaRazryadov:   'Подпрограмма обработки разрядов
'       Единицы
    If I = 1 Or I = 4 Or I = 7 Or I = 10 Then
        If Len(CHAST) = 1 And n(I) = "0" Or CHAST = "00" Or CHAST = "000" Then CIFRA(I) = "ноль "
        If n(I) = "1" Then
          CIFRA(I) = "одна "
          If CHAST = CELOE Then clValuta = "целая "
          If CHAST = DROB Then drValuta = " тысячная"
        End If
'            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
    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
Return

End Function