Как вставить сумму прописью в ячейку таблицы «Excel». Скачать готовый макрос.

По какой-то странной бухгалтерской традиции во всех первичных и закрывающих документах требуется прописывать сумму полученных или оплаченных денежных средств прописью. Выписываешь счет — «укажите сумму прописью», закрываешь командировку — «укажите сумму прописью» и т.д.
Все бы ничего, да вот только некоторые числа в русском языке не только написать, но и выговорить без ошибок сложно.
Если вам приходится изо дня в день заполнять множество бухгалтерской документации, работа начинает напоминать маленькую каторгу.
Существует способ упростить внесение суммы прописью в документ, если сформировать форму документа в программе «Excel», а в клетку (ячейку) для ввода текстового значения суммы подставить формулу, которая переводит число в текст. Аргументом этой функции указать ячейку, в которую ставят сумму числом.

Остается вопрос: «Где взять функцию преобразующую число в текст?»
Ответ довольно прозаичен: «Нужно написать специальный макрос».

Если у Вас возникают трудности с написанием ниже приведенного макроса, можете получить его в готовой надстройке по ссылке поддержав сайт.

Ниже приведен макрос создания такой функции.

Function СУММА_ПРОПИСЬЮ (n As Double) As String

Dim RuExcel1, RuExcel2, RuExcel3, RuExcel4 As Variant

RuExcel1 = Array(«», «один «, «два «, «три «, «четыре «, «пять «, «шесть «, «семь «, «восемь «, «девять «)
RuExcel2 = Array(«», «десять «, «двадцать «, «тридцать «, «сорок «, «пятьдесят «, «шестьдесят «, «семьдесят «, _
«восемьдесят «, «девяносто «)
RuExcel3 = Array(«», «сто «, «двести «, «триста «, «четыреста «, «пятьсот «, «шестьсот «, «семьсот «, _
«восемьсот «, «девятьсот «)
RuExcel4 = Array(«», «одна «, «две «, «три «, «четыре «, «пять «, «шесть «, «семь «, «восемь «, «девять «)
RuExcel5 = Array(«десять «, «одиннадцать «, «двенадцать «, «тринадцать «, «четырнадцать «, _
«пятнадцать «, «шестнадцать «, «семнадцать «, «восемнадцать «, «девятнадцать «)

If n <= 0 Then

СУММА_ПРОПИСЬЮ = «ноль»

Exit Function

End If ‘делим число на разряды, при помощи функции Class

ed = Class(n, 1)

dec = Class(n, 2)

sot = Class(n, 3)

tys = Class(n, 4)

dectys = Class(n, 5)

sottys = Class(n, 6)

mil = Class(n, 7)

decmil = Class(n, 8) ‘ Рассчет миллионов

Select Case decmil

Case 1

mil_txt = RuExcel5(mil) & «миллионов » GoTo millend

Case 2 To 9

decmil_txt = RuExcel2(decmil)

End Select

Select Case mil

Case 1

mil_txt = RuExcel1(mil) & «миллион »

Case 2, 3, 4

mil_txt = RuExcel1(mil) & «миллиона »

Case 5 To 20

mil_txt = RuExcel1(mil) & «миллионов »

End Select

millend: sottys_txt = RuExcel3(sottys) ‘Рассчет тысяч

Select Case dectys

Case 1

tys_txt = RuExcel5(tys) & «тысяч » GoTo tysend

Case 2 To 9

dectys_txt = RuExcel2(dectys)

End Select

Select Case

tys Case 0

If dectys > 0 Then tys_txt = RuExcel4(tys) & «тысяч « Case 1
tys_txt = RuExcel4(tys) & «тысяча «
Case 2, 3, 4
tys_txt = RuExcel4(tys) & «тысячи «
Case 5 To 9
tys_txt = RuExcel4(tys) & «тысяч «
End Select
If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & » тысяч «
tysend:
sot_txt = RuExcel3(sot)
‘Рассчет десятков
Select Case dec
Case 1
ed_txt = RuExcel5(ed)
GoTo desend
Case 2 To 9
dec_txt = RuExcel2(dec)
End Select

ed_txt = RuExcel1(ed)
desend:
‘Сведение итога
СУММА_ПРОПИСЬЮ = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
End Function

‘формирование из числа(цифры) разрядов
Private Function Class(M, I)
Class = Int(Int(M — (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I — 1))
End Function

 

Этот макрос создает функцию преобразующую числа от 0 до 19 млн. в текстовые значения.

Для преобразования рублей с копейками следует сделать отдельные ячейки для рублей и отдельные ячейки для копеек, так как данная версия макроса считает значения только до запятой (целочисленные значения).

Естественно его можно отредактировать и подстроить под необходимый Вам числовой диапазон, добавить знаки пунктуации и т.д.