Где найти функцию перевода из цифр в пропись?

Вопрос:

    Не подскажете где найти функцию, перевода из цифр в пропись и как её нужно будет засунуть в Exel. Пример: 234, 20 => двести тридцать четыре рубля двадцать копеек.
    

Ответ:

    Можете посмотреть на сайте vbnet.ru в разделе Библиотека кодов, а можете использовать следующий код:
    Dim Сумма As Currency, Остаток As Currency
    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 Double) As String
    ' Параметры: Используются глобальные параметры
    ' Сумма, Остаток и Подпись
    ' Назначение: Перевод СуммыСчета в строковую константу
    ' Возвращает: СуммуПрописью
    Dim Группа As Long, Разряд As Long, Длина As
    Integer
    Dim Пропись As String
    Dim cents As String
    Dim cent As Long
    cent = Format (CInt ( (СуммаСчета - Fix (СуммаСчета))
    * 100))
    Сумма = СуммаСчета
    If Сумма < CLng (Сумма) Then Сумма = Сумма - 1
    Остаток = Сумма
    Группа = Остаток \ 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
    Разряд = Группа
    Пропись = Пропись & Единицы (Разряд, "Мужской")
    Остаток = Остаток - Разряд
    Пропись = Пропись & Рубли (Разряд)
    End If
    Длина = Len (Пропись)
    If IsNull (Длина) Then
    Exit Function
    End If
    Пропись = UCase (Mid (Пропись, 1, 1)) &
    (Mid (Пропись, 2, Длина))
    If cent < 20 Then
    cents = Единицы (cent, "Женский")
    Else
    cents = Десятки (CInt (cent / 10))
    cents = cents & Единицы (CInt (cent - (CInt (cent /
    10) * 10)), "Женский")
    End If
    СуммаПрописью = Пропись & " " & cents & "коп."
    End Function
    Function Тысячи (Разряд As Long) As String
    If Разряд = 1 Then
    Тысячи = "тысяча "
    ElseIf Разряд > 1 And Разряд < 5 Then
    Тысячи = "тысячи "
    Else
    Тысячи = "тысяч "
    End If
    End Function

    Сурменок Павел