Sub Макрос1()
    Sheets("Лист1").Select
    a123 = Range("A1").Value
    Range("B1").Value = СуммаПрописью(a123)
End Sub



Function Десятки(Разряд As Long) As String

    Select Case Разряд
         Case  2 
            Десятки = "двадцать "
         Case  3 
            Десятки = "тридцать "
         Case  4 
            Десятки = "сорок "
         Case  5 
            Десятки = "пятьдесят "
         Case  6 
            Десятки = "шестьдесят "
         Case  7 
            Десятки = "семьдесят "
         Case  8 
            Десятки = "восемьдесят "
         Case  9 
            Десятки = "девяносто "
    End Select

End Function

Function Единицы(Разряд As Long, Род As String) As String

    Select Case Разряд
        Case  1 
            If Род = "Мужской" Then
                Единицы = "один "
            Else
                Единицы = "одна "
            End If
        Case  2 
            If Род = "Мужской" Then
                Единицы = "два "
            Else
                Единицы = "две "
            End If
        Case  3 
            Единицы = "три "
        Case  4 
            Единицы = "четыре "
        Case  5 
            Единицы = "пять "
        Case  6 
            Единицы = "шесть "
        Case  7 
            Единицы = "семь "
        Case  8 
            Единицы = "восемь "
        Case  9 
            Единицы = "девять "
        Case  10 
            Единицы = "десять "
        Case  11 
            Единицы = "одиннадцать "
        Case  12 
            Единицы = "двенадцать "
        Case  13 
            Единицы = "тринадцать "
        Case  14 
            Единицы = "четырнадцать "
        Case  15 
            Единицы = "пятнадцать "
        Case  16 
            Единицы = "шестнадцать "
        Case  17 
            Единицы = "семнадцать "
        Case  18 
            Единицы = "восемнадцать "
        Case  19 
            Единицы = "девятнадцать "

    End Select

End Function


Function Миллионы(Разряд As Long) As String

    If Разряд =  1  Then
        Миллионы = "миллион "
    ElseIf Разряд >  1  And Разряд <  5  Then
        Миллионы = "миллиона "
    Else
        Миллионы = "миллионов "
    End If

End Function

Function Рубли(Разряд As Long) As String
    
    If Разряд =  1  Then
        Рубли = "рубль"
    ElseIf Разряд >  1  And Разряд <  5  Then
        Рубли = "рубля"
    Else
        Рубли = "рублей"
    End If

End Function

Function Сотни(Разряд As Long) As String
    
    Select Case Разряд
         Case  1 
            Сотни = "сто "
         Case  2 
            Сотни = "двести "
         Case  3 
            Сотни = "триста "
         Case  4 
            Сотни = "четыреста "
         Case  5 
            Сотни = "пятьсот "
         Case  6 
            Сотни = "шестьсот "
         Case  7 
            Сотни = "семьсот "
         Case  8 
            Сотни = "восемьсот "
         Case  9 
            Сотни = "девятьсот "
    End Select

End Function

Function СуммаПрописью(СуммаСчета As Currency) As String
Dim Группа As Long, Разряд As Long, Длина As Integer
Dim Пропись As String, число As String, целое_число As Long, коп As String, копейки As String
    целое_число = Val(СуммаСчета)
    Сумма = целое_число
    Остаток = Сумма
    
    число = Format(СуммаСчета, "000000000.00")
    
    Группа = Остаток \  1000000 
    If Группа <>  0  Then
        Разряд = Группа \  100 
        Пропись = Пропись & Сотни(Разряд)
        Остаток = Остаток - Разряд *  100  *  1000000 
        Группа = Группа - Разряд *  100 

        If Группа >  19  Then
            Разряд = Группа \  10 
            Пропись = Пропись & Десятки(Разряд)
            Остаток = Остаток - Разряд *  10  *  1000000 
            Группа = Группа - Разряд *  10 
        End If

        Разряд = Группа
        Пропись = Пропись & Единицы(Разряд, "Мужской")
        Остаток = Остаток - Разряд *  1000000 

        Пропись = Пропись & Миллионы(Разряд)
    End If

    Группа = Остаток \  1000 
    If Группа <>  0  Then
        Разряд = Группа \  100 
        Пропись = Пропись & Сотни(Разряд)
        Остаток = Остаток - Разряд *  100  *  1000 
        Группа = Группа - Разряд *  100 

        If Группа >  19  Then
            Разряд = Группа \  10 
            Пропись = Пропись & Десятки(Разряд)
            Остаток = Остаток - Разряд *  10  *  1000 
            Группа = Группа - Разряд *  10 
        End If

        Разряд = Группа
        Пропись = Пропись & Единицы(Разряд, "Женский")
        Остаток = Остаток - Разряд *  1000 

        Пропись = Пропись & Тысячи(Разряд)
    End If

    Группа = Остаток
    If Группа <>  0  Then
        Разряд = Группа \  100 
        Пропись = Пропись & Сотни(Разряд)
        Остаток = Остаток - Разряд *  100 
        Группа = Группа - Разряд *  100 

        If Группа >  19  Then
            Разряд = Группа \  10 
            Пропись = Пропись & Десятки(Разряд)
            Остаток = Остаток - Разряд *  10 
            Группа = Группа - Разряд *  10 
        End If

        Разряд = Группа
        Пропись = Пропись & Единицы(Разряд, "Мужской")
        Остаток = Остаток - Разряд

        Пропись = Пропись & Рубли(Разряд)
    Else
        Пропись = Пропись & "рублей"
    End If

    коп = Right(число,  2 )
    If Val(коп) =  1  Then
         копейки = " копейка"
    End If
    If Val(коп) =  2  Or Val(коп) =  3  Or Val(коп) =  4  Then
         копейки = " копейки"
    End If
    If Val(коп) =  5  Or Val(коп) >  5  Or Val(коп) =  0  Then
         копейки = " копеек"
    End If
    Пропись = Пропись & " " & Right(число,  2 ) & копейки
    
    Длина = Len(Пропись)
    If IsNull(Длина) Then
       СуммаПрописью = " "
       Exit Function
    End If

    Пропись = UCase(Mid(Пропись,  1 ,  1 )) & (Mid(Пропись,  2 , Длина))

    СуммаПрописью = Пропись

End Function
    

Function Тысячи(Разряд As Long) As String

    If Разряд =  1  Then
        Тысячи = "тысяча "
    ElseIf Разряд >  1  And Разряд <  5  Then
        Тысячи = "тысячи "
    Else
        Тысячи = "тысяч "
    End If

End Function