Как вставить сумму прописью в ячейку таблицы «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 млн. в текстовые значения.
Для преобразования рублей с копейками следует сделать отдельные ячейки для рублей и отдельные ячейки для копеек, так как данная версия макроса считает значения только до запятой (целочисленные значения).
Естественно его можно отредактировать и подстроить под необходимый Вам числовой диапазон, добавить знаки пунктуации и т.д.