Постановка задачи.
В работе часто встречается ситуация, когда необходимо вывести числовые значения в виде текста. Например, написать не «150», а «сто пятьдесят». В основном с такой задачей сталкиваются те, кто имеет дело с различными платежными бланками и банковскими ведомостями. Сумма прописью в таких документах должна быть обязательно указана.
Заинтересовавшись этой проблемой, я решил не изобретать велосипед и посмотреть решения данной проблемы в интернете. Скажу сразу, поиск был долгим. Решения были либо чересчур громоздкими, либо в виде нескольких процедур и функций. Меня это не удовлетворяло. В других случаях код и его описание было очень невразумительным.
В результате поисков решение все-таки было найдено. Честно скажу, не запомнил сайт-источник. В этом я искренне каюсь и прошу прощения у автора. Также прошу прощения, что внес небольшие исправления. Итак, используем возможности VBA.
Найденное решение.
Итак, смотрим код:
Public Function СуммаПрописью(x As Double) As String
If x > 999999999999.99 Then
СуммаПрописью = “Аргумент больше 999 999 999 999.99!”
ElseIf x < 0="">
СуммаПрописью = “Аргумент отрицательный!”
Else
x = FormatNumber(x, 2)
Dim b As Byte, b1 As Byte, b2 As Byte, kop As String
b = (x – Fix(x)) * 100
b2 = b 10
b1 = b Mod 10
If b2 <> 1 And b1 = 1 Then
kop = ” тиын”
ElseIf b2 <> 1 And b1 > 1 And b1 < 5="">
kop = ” тиын”
Else
kop = ” тиын”
End If
kop = b2 & b1 & kop
Dim y(1 To 4) As Integer, i1 As Byte
For i1 = 1 To 4
x = Fix(x) / 1000
y(i1) = (x – Fix(x)) * 1000
Next
Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _
y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _
Text4 As String
For i2 = 1 To 4
y1 = y(i2) Mod 10
y2 = (y(i2) – y1) / 10 Mod 10
y3 = y(i2) 100
Text1 = Choose(y3 + 1, “”, “сто “, “двести “, “триста “, “четыреста “, _
“пятьсот “, “шестьсот “, “семьсот “, “восемьсот “, “девятьсот “)
Text2 = Choose(y2 + 1, “”, “”, “двадцать “, “тридцать “, “сорок “, _
“пятьдесят “, “шестьдесят “, “семьдесят “, “восемьдесят “, “девяносто “)
If y2 = 1 Then
Text3 = Choose(y1 + 1, “десять “, “одиннадцать “, “двенадцать “, _
“тринадцать “, “четырнадцать “, “пятнадцать “, “шестнадцать “, _
“семнадцать “, “восемнадцать “, “девятнадцать “)
ElseIf y2 <> 1 And i2 = 2 Then
Text3 = Choose(y1 + 1, “”, “одна “, “две “, “три “, “четыре “, “пять “, _
“шесть “, “семь “, “восемь “, “девять “)
Else
Text3 = Choose(y1 + 1, “”, “один “, “два “, “три “, “четыре “, “пять “, _
“шесть “, “семь “, “восемь “, “девять “)
End If
If y2 <> 1 And y1 = 1 Then
Text4 = Choose(i2, “тенге “, “тысяча “, “миллион “, “миллиард “)
ElseIf y2 <> 1 And y1 > 1 And y1 < 5="">
Text4 = Choose(i2, “тенге “, “тысячи “, “миллиона “, “миллиарда “)
ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then
Text4 = Choose(i2, “тенге “, “”, “”, “”)
Else
Text4 = Choose(i2, “тенге “, “тысяч “, “миллионов “, “миллиардов “)
End If
Text(i2) = Text1 & Text2 & Text3 & Text4
Next
If y(1) + y(2) + y(3) + y(4) = 0 Then
Text0 = “ноль тенге ” & kop
Else
Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop
End If
СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)
End If
End Function
Добавим код в Excel.
Обратите внимание, что вместо слов «тенге» и «тиын» вы поставите свои варианты. В России это будут соответственно рубли и копейки, в США доллары и центы, у остальных свои признаки. Можно вообще убрать эти названия, тогда получим только значения в виде текста.
Данный код можно вставить непосредственно в файл, однако это не выход. Мало того, что файл придется сохранять как файл с поддержкой макросов, так еще и в других файлах придется заново подключать функцию. Поступим по-другому.
1. Создадим новый файл. Зайдем на вкладку «Вид», перейдем в блок «Макросы» и дадим команду «Запись макроса». Название не трогаем, но местом хранения укажем личную книгу макросов, как на рисунке.
После этого, не выполняя никаких действий, вновь переходим «ВИД» → «МАКРОСЫ» → «Остановить запись. Эти действия необходимы для получения доступа к личной книге макросов.
2. Нажимаем сочетание клавиш «Alt + F11». Это значит, что надо нажать клавишу Alt и , не отпуская ее, клавишу F11 в верхнем ряду клавиатуры. На ноутбуке, вероятно, надо дополнительно удерживать клавишу Fn внизу рядом с клавишей Ctrl. Это уже зависит от настройки ноутбука. Если у вас активна вкладка «разработчик», то можно нажать соответствующую кнопку в ней.
3. В результате откроется окно редактора VBA. С левой стороны щелкаем по элементу «VBAProject (PERSONAL.XLSB)». Это и есть наша личная книга макросов.
4. На следующем шаге выбираем в верхнем меню команду «Insert» → «Module». Откроется пустое окно , в которое и копируем указанный выше код.
5. Закрываем редактор VBA и файл Excel, соглашаясь с изменениями в личной книге макросов. Сам файл Excel сохранять не надо!
Применение функции
Применение созданной функции “СуммаПрописью” позволит легко преобразовать числовое значение в число прописью в текстовом виде. Выбираем ячейку рядом с той, которая содержит числовые значения и нажимаем на кнопку вставки функции или сочетание клавиш «Shift + F3». В списке категорий находим вариант «Определенные пользователем», а внизу – нашу функцию.
Щелкаем в появившемся окне по ячейке с цифрами:
И любуемся результатом.
Конечно никто не мешает протянуть формулу вниз, чтобы применить ее к нижним ячейкам. Получившиеся в итоге формулы можно скопировать и вставить с виде только значений.
После этого начальный диапазон с формулами можно удалить. Обратите внимание, что у вас не получиться вставить в виде значений формулу, если вы не скопируете ячейки с ней, а вырежете.
Коррекция функции.
Желающие могут поэкспериментировать с функцией, например изменив, как я, названия валюты. Еще пример – разделить по знаку «запятая» значения в ячейках, применить функцию по отдельности к каждой части, а затем соединить результат в одно целое c помощью функций сцепить. В этом случае лучше для знаков после запятой использовать копию указанной функции. Замените в ней нужные места на свои. В частности, вместо слов «сто» и «тысяча» необходимо будет написать «сотых» и «тысячных», ну и так далее. Предлагаю включить вашу фантазию. Кроме этого, если у вас английская версия Windows, то, скорее всего, название функции выйдет в виде иероглифов. Тогда в тексте функции надо поменять везде название на русском языке на название латинскими символами, например вместо СуммаПрописью вставит ValueToText.
На этом наше небольшое занятие подходит к концу. Всем удачи!
PS. В зависимости от браузера возможны проблемы с копированием текста модуля. Это может быть связано с кодировкой, неверным отображением кавычек и прочими нюансами. Поэтому выкладываю для скачивания свой готовый модуль, который достаточно просто импортировать в личную книгу макросов.
Ссылка на модуль. .
