Option Compare Text

Function ЧИСЛИТ(число As Double, Optional текст As String = "RUB", Optional дробная_часть As Integer = 0) As String
'
'число - числовое значение, которое нужно преобразовать в 'число прописью'
'текст - сокращенное наименование валюты (RUB,USD,EUR). По умолчанию - RUB
'дробная_часть - преобразовагте дробной части (1 - да, 0 - нет). По умолчанию - 0(нет)

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 текст = "AMD" Then
'    clValuta = "драм "
'
'    If Val(Right$(CELOE, 1)) >= 2 And Val(Right$(CELOE, 1)) <= 4 Then clValuta = "драма " Else clValuta = "драм "
'    If Val(Right$(CELOE, 2)) >= 10 And Val(Right$(CELOE, 2)) <= 19 Then clValuta = "драм "
'
'    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