Сумма прописью с валютой excel - Word и Excel - помощь в работе с программами

На сайте gb.by в разделе «Файлы настройки форм», а так же у Агентства Гревцова в свободном доступе была экселевская надстройка (макрос) Деньги прописью.xla, Цифры прописью.xla, позволяющая с помощью встроенных функций переводить числовые/денежные значения в пропись. Поиски в сети так же не принесли результата — надстройки либо работают не корректно (не выводят копейки), либо не запускаются совсем. Поэтому было решено по действующим стандартам написать свою.

Вариант №1 более надежный: за основу взят шаблон российского файла и переписан под валюты: евро, доллар США, белорусский рубль, российский рубль, казахстанский тенге, украинская гривна. Файл СуммаПрописью.xlam(.rar) протестирован несколько месяцев «в боевых условиях» офисными работниками и доступен для свободного скачивания.
Вариант №2 более быстрый: на одном из форумов нашёл пример реализации данной функции с помощью формулы, то есть без применения макросов. Также дописал под вышеперечисленные валюты. Формула получается громоздкой, но если нет времени и желаний возится с встраиванием надстройки в Excel, то можно воспользоваться и таким способом.

* — устранение ошибки: архив поврежден или имеет неизвестный формат. иногда на данный макрос при распаковке архива возможны ложные срабатывания антивирусных программ, поэтому рекомендуется временно отключить защиту.

Установка

Запускаем Excel. Файл — Параметры — Надстройки.

Управление: Надстройки Excel — Перейти…

Кнопка «Обзор» — копируем скачанный и распакованный файл СуммаПрописью_1Cnik.by.xlam в папку «C:UsersUserAppDataRoamingMicrosoftAddIns» и выбираем его.

Надстройка «Сумма прописью» появляется в списке. Ставим галку.

На листе Excel вызываем необходимую функцию из категории: «Определенные пользователем» или прописываем в ячейке вручную с сылкой на числовое поле:

=СуммаПрописьюBYN(Nячейки) — функция возвращает сумму прописью в белорусских рублях BYN

=СуммаПрописьюEUR(Nячейки) — функция возвращает сумму прописью в евро EUR

=СуммаПрописьюRUB(Nячейки) — функция возвращает сумму прописью в российских рублях RUB

=СуммаПрописьюUSD(Nячейки) — функция возвращает сумму прописью в долларах USD

Обновление 08.2021 (добавлены новые валюты):

=СуммаПрописьюKZT(Nячейки) — функция возвращает сумму прописью в казахстанских тенге KZT

=СуммаПрописьюUAH(Nячейки) — функция возвращает сумму прописью в украинских гривнах UAH

Обновление 10.2021 (добавлены новые валюты):

=СуммаПрописьюBYN(Nячейки) — функция возвращает сумму прописью в белорусских рублях BYN — удалена лишняя запятая

=СуммаПрописьюRUBRB(Nячейки) — функция возвращает сумму прописью в российских рублях RUB — создан дополнительный спец.формат для выписки документов в РБ для РФ (вместо «рублей», возвращает «российских рублей»)

Получаем выбранную сумму прописью!

Если категория: «Определенные пользователем» не отображается, а функции недоступны. Скорее всего Excel заблокировал макрос. Для активации надстройки нужно отключить защищенный просмотр. Открываем Файл – Параметры – Центр управления безопасностью – кнопка «Параметры центра управления безопасностью…».

Вкладка «Защищенный просмотр» — снять все галки «Включить защищенный просмотр…». Проверяйте! Надстройка должна стать активной!

Состав архива:

Пример в Excel.xlsx
SummaPropisjuBYN.txt — формула возвращает сумму прописью в белорусских рублях BYN
SummaPropisjuEUR.txt — формула возвращает сумму прописью в евро EUR
SummaPropisjuUSD.txt — формула возвращает сумму прописью в долларах USD
SummaPropisjuKZT.txt — формула возвращает сумму прописью в казахстанских тенге KZT
SummaPropisjuUAH.txt — формула возвращает сумму прописью в украинских гривнах UAH
SummaPropisjuRUB.txt — формула возвращает сумму прописью в российских рублях RUB
SummaPropisjuRUBRB.txt — формула возвращает сумму прописью в российских рублях RUB для выписки документов в РБ для РФ (вместо «рублей», возвращает «российских рублей»)

Плюс данного метода состоит в том, что настраивать ничего не надо. Достаточно скопировать формулу из нужного файла и вставить в ячейку, в которую нужно выводить денежную сумму прописью. Минусы метода: громоздкая формула и для изменения числовой ячейки (A1) каждый раз нужно менять всякое её упоминание во всей формуле (по умолчанию A1).

Примечание: если у Вас в Excel установлен разделитель целой и дробной части – ‘точка’. То для того чтобы формула корректно работала — нужно в формуле найти ТЕКСТ(A1;»0,00″) и заменить на ТЕКСТ(A1;»0.00″).

Вставка формулы в Excel

Открываем текстовый файл с формулой (например: SummaPropisjuRUB_1Cnik.by.txt) в блокноте.

В меню нажимаем: Правка -> Заменить (Ctrl+H). Например: нужная нам сумма (число) расположено на листе Excel в
ячейке A3. Следовательно заменяем все значения в формуле с A1 на A3

Вставляем формулу, например в ячейку A4 и нажимаем Ввод

В ячейке A4 получаем сумму прописью в нужной нам валюте

Перепечатка текста и фотографий разрешена при наличии прямой ссылки на источник

Источник

Содержание

Сумма прописью в excel
Функция сумма прописью на русском языке
Вставка суммы прописью через пользовательскую форму
Подробный синтаксис функции
Функция сумма прописью на украинском языке
Функция сумма прописью на английском языке
Число прописью в Excel: инструкция, как написать сумму
Как в Excel сделать сумму прописью
Формула суммы прописью в Excel — как написать число
Преобразование с помощью макросов Excel

Сумма прописью в excel

Функция сумма прописью на русском языке

После установки надстройки VBA-Excel добавится функционал для вставки суммы прописью. Он содержит удобную форму для ввода (см. рисунок справа), а также функцию СУММАПРОПИСЬЮ, которой можно пользоваться так же как и любой встроенной в Excel.

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

Вы можете указать сумму прописью в договоре в рублях (как с копейками так и без), в долларах США или евро (с центами или без). Помимо суммы договора можно прописывать прописью и срок в календарных или рабочих днях. Можно указывать количество товара прописью в штуках.

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

Вставка суммы прописью через пользовательскую форму

Наиболее простой способ вставить сумму прописью — это заполнить специальную форму.

Выберите ячейку, в которую необходимо вставить число прописью.
На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Русский.
Появится диалоговое окно для выбора параметров функции. Заполните ее так как необходимо Вам. Настройки автоматически сохраняются, чтобы не пришлось повторять действия в следующий раз.
Нажмите Вставить текстом, тогда сумма прописью будет вставлена в ячейку как текст. Нажмите Вставить формулой в случае если в ячейку должна быть вставлена формула, в этом случае сумма прописью будет автоматически изменяться при редактировании числа.

Второй способ вставить сумму прописью — это ввести формулу в ячейку: =СУММАПРОПИСЬЮ(A1), где A1 — ссылка на ячейку с формулой.

Далее рассмотрим подробнее синтаксис функции.

Подробный синтаксис функции

Для использования функции не обязательно постоянно вызывать форму с параметрами. Функцию можно использовать также как и прочие функции Excel. Функция имеет следующие переменные:

=СУММАПРОПИСЬЮ(Число; [Падеж]; [Тип_данных] ; [Дробь_прописью] ; [Дублировать_число] ; [Скобки] ; [Заглавная] )

Квадратные скобки означают что переменная не обязательная, в этом случае используется значение по умолчанию.

Число — ссылка на ячейку или число (не обязательно в числовом формате), которое необходимо написать прописью.
[Падеж] — число от 1 до 6, определяющее падеж

Именительный (по умолчанию если параметр не указан)
Родительный
Дательный
Винительный
Творительный
Предложный

[Тип_данных] — число от 0 до 8 для добавления после суммы прописью в нужном падеже тип данных

Ничего (по умолчанию если параметр не указан)
Рубли
Доллары США
Евро
Календарные дни
Рабочие дни
Дни
Штуки
Целое + дробная часть

[Дробь_прописью] — значение 0 или 1, которое указывает на необходимость записи дробной части числа прописью

Не выводить прописью дробную часть числа (по умолчанию)
Указать прописью также и дробную часть числа

[Дублировать_число] — значение 0 или 1, которое указывает на необходимость дублирования числа перед суммой прописью

Скрыть число перед суммой прописью
Продублировать числовое значение суммы прописью (по умолчанию)

[Скобки] — значение 0 или 1, которое указывает на необходимость записывать сумму прописью в скобках

Убрать скобки из суммы прописью
Поместить сумму прописью в скобки (по умолчанию)

[Заглавная] — значение 0 или 1, которое указывает на необходимость делать первую букву суммы прописью заглавной

Все буквы суммы прописью строчные
Сделать первую букву заглавной (по умолчанию)

Разберем синтаксис функции на примерах:

Склонение числительных по падежам.

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

Как прописать дробную часть числа с помощью функции.

Различные форматы вывода суммы прописью.

Функция сумма прописью на украинском языке

Аналогичный функционал для вставки суммы прописью есть и для украинского языка. Также имеется похожая форма для удобной вставки и функция СУММАПРОПИСЬЮУКР.

Чтобы вызвать форму для вставки суммы прописью на украинском языке, выполните следующие действия:

Выберите ячейку, в которую необходимо вставить число прописью.
На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Украинский.
Дальнейшие действия аналогичны

Функция сумма прописью на английском языке

Функция сумма прописью на английском языке несколько проще чем описанные выше. Тут нет падежей и формат прописи всегда один.

Чтобы вставить число прописью на английском языке нужно:

Выбрать ячейку в которую необходимо вставить результат
На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Английский.
Укажите число и нажмите одну из кнопок Вставить формулой или Вставить текстом.

Вместо формы ввода, Вы также можете пользоваться функцией =СУММАПРОПИСЬЮEN(ЧИСЛО). Функция имеет один аргумент: ЧИСЛО — значение или ссылка на ячейку с числом, которое необходимо преобразовать в текст прописью.

Источник

Число прописью в Excel: инструкция, как написать сумму

Во многих документах мы можем видеть строку, в которой требуется указать сумму не в числовом виде, а прописью. Это защищает отчетность от подделки, ведь цифру легко переправить. А вот длинную запись незаметно исправить не так-то просто. Сумма прописью в Excel доступна только в виде надстроек или с использованием формул. Встроенного инструмента не имеется.

Как в Excel сделать сумму прописью

Чтобы получить эту возможность, вы можете скачать надстройку «Сумма прописью» в Excel бесплатно на нашем сайте.

Разместите его в любом удобном каталоге и подключите. Для этого следует пройти следующие этапы:

Эта функция «сумма_прописью» работает в Excel 2007, 2010, 2016

Данная надстройка работает только для рублей. Если вам нужна другая валюта, скачайте еще файл sumprop.xla. Действуя по аналогии подключите надстройку для получения суммы прописью в Excel.

Для проверки введем в ячейке A3 произвольное число. Пусть это будет десятичная дробь. Также вызовем окно вставки функций и найдем новые функции для вывода суммы прописью.

Как видите, нам стали доступны:

Сумма Прописью
Сумма Прописью Доллары
Сумма Прописью Евро
Сумма Прописью Евро

Переведем число в евро. Выбираем соответствующую функцию и кликаем по ячейке с числом.

После нажатия ОК получаем результат.

С помощью этих инструментов преобразование числа в текст прописью в Excel выполняется очень просто. Если по каким-то причинам вы не хотите устанавливать их в Excel, можно воспользоваться другим способом.

Формула суммы прописью в Excel — как написать число

Для вывода числа прописью в Excel можно создать формулу. Приведем пример:

Для ее использования вам необходимо указать несколько массивов Excel:

Просто скопируйте эту таблицу на лист Excel, а формулу вставляйте туда, где необходима сумма прописью. Вышеприведенная конструкция предназначена для ячейки A3. Не забудьте поменять адрес.

В англоязычном Excel формула суммы прописью будет выглядеть следующим образом:

SUBSTITUTE(PROPER(INDEX(n_4,MID(TEXT(A1,n0),1,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),2,1)+1,MID(TEXT(A1,n0),3,1)+1)&IF(-MID(TEXT(A1,n0),1,3),»миллиард»&VLOOKUP(MID(TEXT(A1,n0),3,1)*AND(MID(TEXT(A1,n0),2,1)-1),мил,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),4,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),5,1)+1,MID(TEXT(A1,n0),6,1)+1)&IF(-MID(TEXT(A1,n0),4,3),»миллион»&VLOOKUP(MID(TEXT(A1,n0),6,1)*AND(MID(TEXT(A1,n0),5,1)-1),мил,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),7,1)+1)&INDEX(n1x,MID(TEXT(A1,n0),8,1)+1,MID(TEXT(A1,n0),9,1)+1)&IF(-MID(TEXT(A1,n0),7,3),VLOOKUP(MID(TEXT(A1,n0),9,1)*AND(MID(TEXT(A1,n0),8,1)-1),тыс,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),10,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),11,1)+1,MID(TEXT(A1,n0),12,1)+1)),»z»,» «)&IF(TRUNC(TEXT(A1,n0)),»»,»Ноль «)&»рубл»&VLOOKUP(MOD(MAX(MOD(MID(TEXT(A1,n0),11,2)-11,100),9),10),<0,»ь «;1,»я «;4,»ей «>,2)&RIGHT(TEXT(A1,n0),2)&» копе»&VLOOKUP(MOD(MAX(MOD(RIGHT(TEXT(A1,n0),2)-11,100),9),10),<0,»йка»;1,»йки»;4,»ек»>,2)

Как видим, это не самый удобный способ преобразовать число в текст прописью в Excel.

Преобразование с помощью макросов Excel

Можно написать собственную функцию, которая произведет конвертацию суммы прописью. Нажмите сочетание ALT+F11 и в открывшемся разработчике Excel VBA вставьте новый модуль.

В него добавьте следующий код.

Теперь эту функцию можно вызвать обычным путем и получить сумму прописью. Она находится в разделе функций Excel «Определенные пользователем».

В качестве аргумента укажите адрес с числом.

Перевод в сумму прописью осуществляется только для целых чисел.

Дробное число требует дополнительной формулы:

Вместо ячейки A7 подставляйте свой адрес. Копейки в таком исполнении будут выводиться в виде числа.

Мы рассмотрели все способы представления суммы прописью в Excel. Выбирайте для себя самый удобный и пользуйтесь с удовольствием!

Источник

Функция Propis

Универсальная функция для вывода суммы прописью для чисел от 0 до 99 999 999 на русском или английском языке для заданной валюты (рубли, доллары, евро).

Синтаксис

=Propis(Amount; Money; Lang; Prec)

где

Amount — ячейка с суммой, которую надо представить прописью
Money — код валюты (RUB, EUR, USD)
Lang — на каком языке вывести сумму (RU или EN)
Prec — надо (1) или нет (0) выводит дробную часть числа, т.е. копейки или центы.

Полный список всех инструментов надстройки PLEX

20.04.2017 08:34:46

Добрый день!
есть ли возможность вывести сумму на украинском языке?

22.04.2017 10:18:13

23.04.2017 00:12:20

было под носом и не увидел
Спасибо!

20.05.2017 13:15:42

Формула вида =Propis(Почта!$Q$2;RUB;RU;0) не работает выдается ошибка…это вставлена через мастер формул в надстройке…работает только =Propis(Q2)

26.10.2017 08:36:27

«RUB» и «RU» должны быть в кавычках — это же текстовые строки, они в любой функции и формуле должны быть заключены в кавычки.

24.08.2018 14:00:51

Николай, это PLEX так ставит

23.08.2017 15:30:06

Добрый день, в данном выше примере функция работает как мне необходимо, но в скачанной версии от мая 2017 понимает только =PropisRus(A2;1) такой вариант, а мне нужно чтобы выводилось полное название копеек рублей и после запятой выводилось 00 копеек а не 0 копеек. Это можно исправить?

26.10.2017 08:42:05

Используйте функцию =Propis(A2) вместо PropisRus.

13.09.2017 02:39:08

А если мне просто число написать нужно, или в конце добавить шткгтоннящиковбанок и т.д.? типа 12,5- двенадцать целых пять десятых или 3шт- три шт?

26.10.2017 08:39:05

Для целых чисел можно использовать функцию PropisRus без дополнительных аргументов и приклеить к ней нужные единицы измерения, т.е. =PropisRus(A1)&» шт.»

25.10.2017 12:17:03

Будьте добры, подскажите, какую формулу можно использовать, чтобы сумму писало прописью русским текстом, а денежную единицу выдавало в укр.валюте (гривне), копейки тоже нужны.
Функция =PropisUkr(N; Hryvnias; Kopecks) работает отлично, но текст только на украинском языке.

26.10.2017 08:35:22

Такого нет. Есть Propis на русском-английском, которая умеет выводить рубли, доллары, евро. И есть PropisUkr, которая выводит гривны на украинском. Если нужна функция-мутант, то придется либо писать свою, либо ждать, когда я добавлю гривны в Propis

26.10.2017 09:50:57

Благодарю за ответ. Все функции Propis уже обошла вдоль и поперёк.
Значит, придётся к макросу обращаться. Но мутация — это хорошо:D Спасибо!

22.03.2018 10:27:30

Добрый день! а если нужно чтобы при использовании функции Propis текст выводился не в рублях а в кг?

20.07.2018 10:34:30

Нужно лезть в исходный код функции на VBA и заменить там везде рубли на «кг».
Либо использовать функцию PropisRus для вывода числа без единиц измерения и приклеить потом к результату «кг»:

17.07.2018 23:37:47

Доброго времени суток! Есть ли возможность вывода на немецком языке суммы прописью? Заранее спасибо за ответ!

20.07.2018 10:31:50

Ну, готовой функции у меня для немецкого языка нет, к сожалению.

11.12.2019 17:57:19

Николай, добрый день!

Обнаружил, чо данная функция некорректно работает со значениями начиная от 10 000 000 000.
Например:

10 000 000 000,00	#ЗНАЧ!
10 000 000 010,00	Десять рублей 00 копеек
15 000 000 000,00	Пять миллиардов рублей 00 копеек

Спасибо.
Алексей

13.12.2019 21:32:11

А первую строчку статьи прочитать?

16.12.2019 10:36:06

Да, действительно, написано. Прошу извинить.
Я давно работаю с этой функцией, по этому подсознательно думал, что все про нее знаю.

К сожалению (или к счастью) приходится работать с большими суммами. Жаль, что функция не работает с ними.

20.12.2019 12:55:52

Добрый день! Пожалуйста, добавьте к функцию сумма прописью национальную валюту Узбекистана — сум и тийин, а также возможность загрузки курсы валют Центрального банка Узбекистана. Спасибо.

21.08.2020 17:01:59

Добрый день. Можно сделать что бы скобки были после слова рубль, а копейки были после скобок?

Цена контракта составляет: 10 500 (Десять тысяч пятьсот рублей) 00 копеек

30.10.2020 18:13:14

Добрый день! Функция PropisRus не работает, пишет #ЗНАЧ. Хотя при выборе аргументов показывает верное значение, но как только нажимаешь ок, то в ячейке высвечивается ошибка. Подскажите что делать?

04.11.2020 17:20:00

Вы бы хоть описали, что именно делаете или скриншот приложили. Как я догадаюсь, в чем проблема?

05.11.2020 11:39:36

Вроде заработало. Открыл отдельный лист в ексель, попробовал и функция заработала. Значит это у меня в другой книге проблемы.

11.02.2021 17:12:27

Добрый день! Николай, отличная надстройка, купил с удовольствием. Но есть одно маленькое но, так как живу в Казахстане очень нужен вывод прописью тенге.

03.08.2021 14:26:39

Добрый день! Если копейки равны 00 или их нет то прописью выводит, если есть копейки то выдает ошибку. Как это исправить.

10.03.2022 11:18:06

Добрый день! Подскажите пожалуйста по этой функции планируется доработка на тенге_тиын. Или может она уже есть. П
опробовала на всякий случай =propiskz ничего не получилось)))

Источник

Public Function Число_в_текст(ByVal SumBase As Double, ByVal Valuta As String) As String
'Переводит цифровое значение в текстовое предложение.
'Параметр Valuta:
' "руб" - рубли,
' "дол" - доллары,
' "евр" - евро,
' "грив"- гривны,
' "крон"- кроны,
' "" - без наименования,
' прочие текстовые наименования валют используются без склонения.
' Копейки и центы добавляются, если сотые значения присутствуют.
'00 копеек добавляется, если есть дробная чаcть равная или более 0,001
    Dim Edinicy(0 To 19) As String
    Dim Desyatki(0 To 9) As String
    Dim Sotni(0 To 9) As String
    Dim mlrd(0 To 9) As String
    Dim mln(0 To 9) As String
    Dim tys(0 To 9) As String
    Dim SumInt, x, shag, vl As Integer
    Dim txt, Sclon_Tys As String
    Dim Naim_Valuta_1 As String, Naim_Valuta_2 As String, Naim_Valuta_5 As String
    Dim Naim_Sotye_1 As String, Naim_Sotye_2 As String, Naim_Sotye_5 As String
    Dim Sotye As Integer, StrSotye As String
    Dim PereKluch  As String
    '---------------------------------------------
    Application.Volatile
    '---------------------------------------------
    Edinicy(0) = ""
    Edinicy(1) = "один "
    Edinicy(2) = "два "
    Edinicy(3) = "три "
    Edinicy(4) = "четыре "
    Edinicy(5) = "пять "
    Edinicy(6) = "шесть "
    Edinicy(7) = "семь "
    Edinicy(8) = "восемь "
    Edinicy(9) = "девять "
    Edinicy(11) = "одиннадцать "
    Edinicy(12) = "двенадцать "
    Edinicy(13) = "тринадцать "
    Edinicy(14) = "четырнадцать "
    Edinicy(15) = "пятнадцать "
    Edinicy(16) = "шестнадцать "
    Edinicy(17) = "семнадцать "
    Edinicy(18) = "восемнадцать "
    Edinicy(19) = "девятнадцать "
    '---------------------------------------------
    Desyatki(0) = ""
    Desyatki(1) = "десять "
    Desyatki(2) = "двадцать "
    Desyatki(3) = "тридцать "
    Desyatki(4) = "сорок "
    Desyatki(5) = "пятьдесят "
    Desyatki(6) = "шестьдесят "
    Desyatki(7) = "семьдесят "
    Desyatki(8) = "восемьдесят "
    Desyatki(9) = "девяносто "
    '---------------------------------------------
    Sotni(0) = ""
    Sotni(1) = "сто "
    Sotni(2) = "двести "
    Sotni(3) = "триста "
    Sotni(4) = "четыреста "
    Sotni(5) = "пятьсот "
    Sotni(6) = "шестьсот "
    Sotni(7) = "семьсот "
    Sotni(8) = "восемьсот "
    Sotni(9) = "девятьсот "
    '---------------------------------------------
    mlrd(0) = "миллиардов "
    mlrd(1) = "миллиард "
    mlrd(2) = "миллиарда "
    mlrd(3) = "миллиарда "
    mlrd(4) = "миллиарда "
    mlrd(5) = "миллиардов "
    mlrd(6) = "миллиардов "
    mlrd(7) = "миллиардов "
    mlrd(8) = "миллиардов "
    mlrd(9) = "миллиардов "
    '---------------------------------------------
    mln(0) = "миллионов "
    mln(1) = "миллион "
    mln(2) = "миллиона "
    mln(3) = "миллиона "
    mln(4) = "миллиона "
    mln(5) = "миллионов "
    mln(6) = "миллионов "
    mln(7) = "миллионов "
    mln(8) = "миллионов "
    mln(9) = "миллионов "
    '---------------------------------------------
    tys(0) = "тысяч "
    tys(1) = "тысяча "
    tys(2) = "тысячи "
    tys(3) = "тысячи "
    tys(4) = "тысячи "
    tys(5) = "тысяч "
    tys(6) = "тысяч "
    tys(7) = "тысяч "
    tys(8) = "тысяч "
    tys(9) = "тысяч "
    '---------------------------------------------
    On Local Error Resume Next
    shag = 0
    SumInt = Int(SumBase)
    For x = Len(SumInt) To 1 Step -1
        shag = shag + 1
        Select Case x
            Case 12 ' - сотни миллиардов
                vl = Mid(SumInt, shag, 1)
                txt = txt & Sotni(vl)
            Case 11 ' - десятки  миллиардов
                vl = Mid(SumInt, shag, 1)
                If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl)  ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
            Case 10 ' - единицы  миллиардов
                vl = Mid(SumInt, shag, 1)
                If shag > 1 Then
                    If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллиардов " Else txt = txt & Edinicy(vl) & mlrd(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады
                Else
                    txt = txt & Edinicy(vl) & mlrd(vl)
                End If
 
                '-КОНЕЦ БЛОКА_______________________
            Case 9 ' - сотни миллионов
                vl = Mid(SumInt, shag, 1)
                txt = txt & Sotni(vl)
            Case 8 ' - десятки  миллионов
                vl = Mid(SumInt, shag, 1)
                If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl)  ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
            Case 7 ' - единицы  миллионов
                vl = Mid(SumInt, shag, 1)
                If shag > 2 Then
                    If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX
                End If
                If shag > 1 Then
                    If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллионов " Else: txt = txt & Edinicy(vl) & mln(vl)  'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады
                Else
                    txt = txt & Edinicy(vl) & mln(vl)
                End If
                '-КОНЕЦ БЛОКА_______________________
            Case 6 ' - сотни тысяч
                vl = Mid(SumInt, shag, 1)
                txt = txt & Sotni(vl)
            Case 5 ' - десятки  тысяч
                vl = Mid(SumInt, shag, 1)
                If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl)  ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
                Case 4 ' - единицы  тысяч
                vl = Mid(SumInt, shag, 1)
                If shag > 2 Then
                    If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX
                End If
                Sclon_Tys = Edinicy(vl) & tys(vl) ' - вводим переменную Sclon_Tys из-за иного склонения  тысяч в русском языке
                If vl = 1 Then Sclon_Tys = "одна " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную  Sclon_Tys )
                If vl = 2 Then Sclon_Tys = "две " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную  Sclon_Tys )
                If shag > 1 Then
                    If Mid(SumInt, shag - 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag - 1, 2)) & "тысяч "
                End If
                txt = txt & Sclon_Tys
                '-КОНЕЦ БЛОКА_______________________
            Case 3 ' - сотни
                vl = Mid(SumInt, shag, 1)
                txt = txt & Sotni(vl)
            Case 2 ' - десятки
                vl = Mid(SumInt, shag, 1)
                If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl)  ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
            Case 1 ' - единицы
                vl = Mid(SumInt, shag, 1)
                If shag > 2 Then
                    If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX
                End If
                If shag > 1 Then
                    If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) Else: txt = txt & Edinicy(vl)
                Else
                    txt = txt & Edinicy(vl)
                End If
                '-КОНЕЦ БЛОКА_______________________
        End Select
LblNextX:
    Next x
    If InStr(1, LCase(Valuta), "руб") > 0 Then Valuta = "рубли"
    If InStr(1, LCase(Valuta), "дол") > 0 Then Valuta = "доллары"
    If InStr(1, LCase(Valuta), "евр") > 0 Then Valuta = "евро"
    If InStr(1, LCase(Valuta), "грив") > 0 Then Valuta = "гривны"
    If InStr(1, LCase(Valuta), "крон") > 0 Then Valuta = "кроны"
    Select Case Valuta
        Case "рубли"
            Naim_Valuta_1 = "рубль"
            Naim_Valuta_2 = "рубля"
            Naim_Valuta_5 = "рублей"
            Naim_Sotye_1 = "копейка"
            Naim_Sotye_2 = "копейки"
            Naim_Sotye_5 = "копеек"
        Case "доллары"
            Naim_Valuta_1 = "доллар"
            Naim_Valuta_2 = "доллара"
            Naim_Valuta_5 = "долларов"
            Naim_Sotye_1 = "цент"
            Naim_Sotye_2 = "цента"
            Naim_Sotye_5 = "центов"
        Case "евро"
            Naim_Valuta_1 = "евро"
            Naim_Valuta_2 = "евро"
            Naim_Valuta_5 = "евро"
            Naim_Sotye_1 = "цент"
            Naim_Sotye_2 = "цента"
            Naim_Sotye_5 = "центов"
        Case "гривны"
            Naim_Valuta_1 = "гривна"
            Naim_Valuta_2 = "гривны"
            Naim_Valuta_5 = "гривен"
            Naim_Sotye_1 = "копейка"
            Naim_Sotye_2 = "копейки"
            Naim_Sotye_5 = "копеек"
        Case "крон"
            Naim_Valuta_1 = "крона"
            Naim_Valuta_2 = "кроны"
            Naim_Valuta_5 = "крон"
            Naim_Sotye_1 = "геллер"
            Naim_Sotye_2 = "геллера"
            Naim_Sotye_5 = "геллеров"
        Case ""
            Naim_Valuta_1 = ""
            Naim_Valuta_2 = ""
            Naim_Valuta_5 = ""
            Naim_Sotye_1 = ""
            Naim_Sotye_2 = ""
            Naim_Sotye_5 = ""
        Case Else
            Naim_Valuta_1 = Valuta
            Naim_Valuta_2 = Valuta
            Naim_Valuta_5 = Valuta
            Naim_Sotye_1 = "сотая"
            Naim_Sotye_2 = "сотых"
            Naim_Sotye_5 = "сотых"
    End Select
    If shag = 1 Then shag = 2
    If vl = 0 Or vl > 4 Or (Mid(SumInt, shag - 1, 2) > 10 And Mid(SumInt, shag - 1, 2) < 20) Then
        txt = txt + Naim_Valuta_5
    Else
        If vl = 1 Then txt = txt + Naim_Valuta_1 Else txt = txt + Naim_Valuta_2
    End If
    Sotye = CInt((SumBase - SumInt) * 100)
    StrSotye = Format(Sotye, "00")
    If CInt((SumBase - SumInt) * 1000) > 0 Then
        txt = txt & " " & StrSotye & " "
        Select Case Left(StrSotye, 1)
            Case "0", "2", "3", "4", "5", "6", "7", "8", "9"
                PereKluch = Right(StrSotye, 1)
            Case Else
                PereKluch = StrSotye
        End Select
        Select Case PereKluch
            Case "1"
                txt = txt & Naim_Sotye_1
            Case "2", "3", "4"
                txt = txt & Naim_Sotye_2
            Case Else
                txt = txt & Naim_Sotye_5
        End Select
    End If
    Число_в_текст = UCase(Left(txt, 1)) & Right(txt, Len(txt) - 1)
End Function
 
Public Function Число_в_текст_руб_коп(Сумма As Currency) As String
    'до 999 999 999 999.99
    On Local Error GoTo RUB_Error
    Dim strРубли As String, strКопейки As String, StrTemp As String
    Dim strМиллиарды As String, strМиллионы As String, strТысячи As String, strЕдиницы As String, strСотые As String
    Dim Поз As Integer
    '---------------------------------------------
    Application.Volatile
    '---------------------------------------------
    
    strРубли = Format(Int(Сумма), "000000000000")
    strКопейки = Format(Int((Сумма - Int(Сумма)) * 100), "00")
    
    'Миллиарды'
    Поз = 1
    strМиллиарды = Сотни(Mid(strРубли, Поз, 1))
    strМиллиарды = strМиллиарды & Десятки(Mid(strРубли, Поз + 1, 2), "м")
    strМиллиарды = strМиллиарды & ИмяРазряда(strМиллиарды, Mid(strРубли, Поз + 1, 2), "миллиард ", "миллиарда ", "миллиардов ")
    
    'Миллионы'
    Поз = 4
    strМиллионы = Сотни(Mid(strРубли, Поз, 1))
    strМиллионы = strМиллионы & Десятки(Mid(strРубли, Поз + 1, 2), "м")
    strМиллионы = strМиллионы & ИмяРазряда(strМиллионы, Mid(strРубли, Поз + 1, 2), "миллион ", "миллиона ", "миллионов ")
    
    'Тысячи'
    Поз = 7
    strТысячи = Сотни(Mid(strРубли, Поз, 1))
    strТысячи = strТысячи & Десятки(Mid(strРубли, Поз + 1, 2), "ж")
    strТысячи = strТысячи & ИмяРазряда(strТысячи, Mid(strРубли, Поз + 1, 2), "тысяча ", "тысячи ", "тысяч ")
    
    'Единицы'
    Поз = 10
    strЕдиницы = Сотни(Mid(strРубли, Поз, 1))
    strЕдиницы = strЕдиницы & Десятки(Mid(strРубли, Поз + 1, 2), "м")
    If strМиллиарды & strМиллионы & strТысячи & strЕдиницы = "" Then strЕдиницы = "ноль "
    strЕдиницы = strЕдиницы & ИмяРазряда(" ", Mid(strРубли, Поз + 1, 2), "рубль ", "рубля ", "рублей ")
    
    
    'Сотые'
    strСотые = strКопейки & " " & ИмяРазряда(strКопейки, Right(strКопейки, 2), "копейка", "копейки", "копеек")
    
    StrTemp = strМиллиарды & strМиллионы & strТысячи & strЕдиницы & strСотые
    Число_в_текст_руб_коп = UCase(Left(StrTemp, 1)) & Right(StrTemp, Len(StrTemp) - 1)
    
    Exit Function
    
RUB_Error:
        MsgBox Err.Description
End Function
 
Private Function Сотни(n As String) As String
    Сотни = ""
    Select Case n
        Case 0: Сотни = ""
        Case 1: Сотни = "сто "
        Case 2: Сотни = "двести "
        Case 3: Сотни = "триста "
        Case 4: Сотни = "четыреста "
        Case 5: Сотни = "пятьсот "
        Case 6: Сотни = "шестьсот "
        Case 7: Сотни = "семьсот "
        Case 8: Сотни = "восемьсот "
        Case 9: Сотни = "девятьсот "
    End Select
End Function
 
Private Function Десятки(n As String, Sex As String) As String
    Десятки = ""
    Select Case Left(n, 1)
        Case "0": Десятки = "": n = Right(n, 1)
        Case "1": Десятки = ""
        Case "2": Десятки = "двадцать ": n = Right(n, 1)
        Case "3": Десятки = "тридцать ": n = Right(n, 1)
        Case "4": Десятки = "сорок ": n = Right(n, 1)
        Case "5": Десятки = "пятьдесят ": n = Right(n, 1)
        Case "6": Десятки = "шестьдесят ": n = Right(n, 1)
        Case "7": Десятки = "семьдесят ": n = Right(n, 1)
        Case "8": Десятки = "восемьдесят ": n = Right(n, 1)
        Case "9": Десятки = "девяносто ": n = Right(n, 1)
    End Select
    
    Dim Двадцатка As String
    Двадцатка = ""
    Select Case n
        Case "0": Двадцатка = ""
        Case "1"
            Select Case Sex
                Case "м": Двадцатка = "один "
                Case "ж": Двадцатка = "одна "
                Case "с": Двадцатка = "одно "
            End Select
        Case "2":
            Select Case Sex
                Case "м": Двадцатка = "два "
                Case "ж": Двадцатка = "две "
                Case "с": Двадцатка = "два "
            End Select
        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
 
Private Function ИмяРазряда(Строка As String, n As String, Имя1 As String, Имя24 As String, ИмяПроч As String) As String
    If Строка <> "" Then
        ИмяРазряда = ""
        Select Case Left(n, 1)
            Case "0", "2", "3", "4", "5", "6", "7", "8", "9": n = Right(n, 1)
        End Select
        
        Select Case n
            Case "1": ИмяРазряда = Имя1
            Case "2", "3", "4": ИмяРазряда = Имя24
            Case Else: ИмяРазряда = ИмяПроч
        End Select
    End If
End Function

Источник

Часто нужно перевести число в текст в Excel так, чтобы оно отображалось прописью (словами) на русском или других языках. Так как по умолчанию нет готовой функции, создадим свою пользовательскую функцию с помощью макросов.

Пример использования пользовательской функции для преобразования числа суммы в текстовые слова, которую можно скачать в конце статьи:

Для создания пользовательской функции, которая сможет перевести число в текст прописью , нам нужно выполнить 3 простых шага:

Открыть редактор макросов ALT+F11.
Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».

Module.

Вставить в модуль следующий код и сохранить:

Function ЧислоПропись(Число As Currency) As String
‘до 999 999 999 999
On Error GoTo Число_Error
Dim strМиллиарды As String, strМиллионы As String, strТысячи As String, strЕдиницы As String, strСотые As String
Dim Поз As Integer

strЧисло = Format(Int(Число),

«000000000000»)

‘Миллиарды’
Поз = 1
strМиллиарды = Сотни(Mid(strЧисло, Поз, 1))
strМиллиарды = strМиллиарды & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллиарды = strМиллиарды & ИмяРазряда(strМиллиарды, Mid(strЧисло, Поз + 1, 2), «миллиард «, «миллиарда «, «миллиардов «)

‘Миллионы’
Поз = 4
strМиллионы = Сотни(Mid(strЧисло, Поз, 1))
strМиллионы = strМиллионы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллионы = strМиллионы & ИмяРазряда(strМиллионы, Mid(strЧисло, Поз + 1, 2), «миллион «, «миллиона «, «миллионов «)

‘Тысячи’
Поз = 7
strТысячи = Сотни(Mid(strЧисло, Поз, 1))
strТысячи = strТысячи & Десятки(Mid(strЧисло, Поз + 1, 2), «ж»)
strТысячи = strТысячи & ИмяРазряда(strТысячи, Mid(strЧисло, Поз + 1, 2), «тысяча «, «тысячи «, «тысяч «)

‘Единицы’
Поз = 10
strЕдиницы = Сотни(Mid(strЧисло, Поз, 1))
strЕдиницы = strЕдиницы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
If strМиллиарды & strМиллионы & strТысячи & strЕдиницы = «» Then strЕдиницы = «ноль «
‘strЕдиницы = strЕдиницы & ИмяРазряда(» «, Mid(strЧисло, Поз + 1, 2), «рубль «, «рубля «, «рублей «)

‘Сотые’
‘strСотые = strКопейки & » » & ИмяРазряда(strКопейки, Right(strКопейки, 2), ‘»копейка», «копейки», «копеек»)

ЧислоПропись = strМиллиарды & strМиллионы & strТысячи & strЕдиницы
ЧислоПропись = UCase(Left(ЧислоПропись, 1)) & Right(ЧислоПропись, Len(ЧислоПропись) — 1)

Exit Function

Число_Error:
MsgBox Err.Description

End Function

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

Function Десятки(n As String, Sex As String) As String
Десятки = «»
Select Case Left(n, 1)
    Case «0»: Десятки = «»: n = Right(n, 1)
    Case «1»: Десятки = «»
    Case «2»: Десятки = «двадцать «: n = Right(n, 1)
    Case «3»: Десятки = «тридцать «: n = Right(n, 1)
    Case «4»: Десятки = «сорок «: n = Right(n, 1)
    Case «5»: Десятки = «пятьдесят «: n = Right(n, 1)
    Case «6»: Десятки = «шестьдесят «: n = Right(n, 1)
    Case «7»: Десятки = «семьдесят «: n = Right(n, 1)
    Case «8»: Десятки = «восемьдесят «: n = Right(n, 1)
    Case «9»: Десятки = «девяносто «: n = Right(n, 1)
End Select

Dim Двадцатка As String
Двадцатка = «»
Select Case n
    Case «0»: Двадцатка = «»
    Case «1»
        Select Case Sex
            Case «м»: Двадцатка = «один «
            Case «ж»: Двадцатка = «одна «
            Case «с»: Двадцатка = «одно «
        End Select
    Case «2»:
        Select Case Sex
            Case «м»: Двадцатка = «два «
            Case «ж»: Двадцатка = «две «
            Case «с»: Двадцатка = «два «
        End Select
    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 String, n As String, Имя1 As String, Имя24 As String, ИмяПроч As String) As String

If Строка <> «» Then
    ИмяРазряда = «»
    Select Case Left(n, 1)
        Case «0», «2», «3», «4», «5», «6», «7», «8», «9»: n = Right(n, 1)
    End Select

Select Case n
        Case «1»: ИмяРазряда = Имя1
        Case «2», «3», «4»: ИмяРазряда = Имя24
        Case Else: ИмяРазряда = ИмяПроч
    End Select
End If

End Function

Можно написать алгоритм макро программы по-другому и еще сделать так, чтобы она дописывала валюту суммы прописью. Для этого создайте Module2 и введите в него следующий код:

Function ЧислоПрописьюВалюта(Число As Double, Optional Валюта As Integer = 1, Optional Копейки As Integer = 1)
Attribute ЧислоПрописьюВалюта.VB_Description = «Функция преобразовывает число суммы текстовыми словами»
Attribute ЧислоПрописьюВалюта.VB_ProcData.VB_Invoke_Func = » n1″
Dim Edinicy(0 To 19) As String: Dim EdinicyPoslednie(0 To 19) As String
Dim Desyatki(0 To 9) As String: Dim Sotni(0 To 9) As String: Dim mlrd(0 To 9) As String
Dim mln(0 To 9) As String: Dim tys(0 To 9) As String
Dim SumInt, x, shag, vl As Integer: Dim txt, Sclon_Tys As String
‘———————————————
Application.Volatile
‘———————————————
Edinicy(0) = «»: EdinicyPoslednie(0) = IIf(Валюта = 0, «евро», IIf(Валюта = 1, «рублей», «долларов»))
Edinicy(1) = «один «: EdinicyPoslednie(1) = IIf(Валюта = 0, «один евро», IIf(Валюта = 1, «один рубль», «один доллар»))
Edinicy(2) = «два «: EdinicyPoslednie(2) = IIf(Валюта = 0, «два евро», IIf(Валюта = 1, «два рубля», «два доллара»))
Edinicy(3) = «три «: EdinicyPoslednie(3) = IIf(Валюта = 0, «три евро», IIf(Валюта = 1, «три рубля», «три доллара»))
Edinicy(4) = «четыре «: EdinicyPoslednie(4) = IIf(Валюта = 0, «четыре евро», IIf(Валюта = 1, «четыре рубля», «четыре доллара»))
Edinicy(5) = «пять «: EdinicyPoslednie(5) = IIf(Валюта = 0, «пять евро», IIf(Валюта = 1, «пять рублей», «пять долларов»))
Edinicy(6) = «шесть «: EdinicyPoslednie(6) = IIf(Валюта = 0, «шесть евро», IIf(Валюта = 1, «шесть рублей», «шесть долларов»))
Edinicy(7) = «семь «: EdinicyPoslednie(7) = IIf(Валюта = 0, «семь евро», IIf(Валюта = 1, «семь рублей», «семь долларов»))
Edinicy(8) = «восемь «: EdinicyPoslednie(8) = IIf(Валюта = 0, «восемь евро», IIf(Валюта = 1, «восемь рублей», «восемь долларов»))
Edinicy(9) = «девять «: EdinicyPoslednie(9) = IIf(Валюта = 0, «девять евро», IIf(Валюта = 1, «девять рублей», «девять долларов»))
Edinicy(11) = «одиннадцать «: EdinicyPoslednie(11) = IIf(Валюта = 0, «одиннадцать евро», IIf(Валюта = 1, «одиннадцать рублей», «одиннадцать долларов»))
Edinicy(12) = «надцать «: EdinicyPoslednie(12) = IIf(Валюта = 0, «надцать евро», IIf(Валюта = 1, «надцать рублей», «надцать долларов»))
Edinicy(13) = «тринадцать «: EdinicyPoslednie(13) = IIf(Валюта = 0, «тринадцать евро», IIf(Валюта = 1, «тринадцать рублей», «тринадцать долларов»))
Edinicy(14) = «четырнадцать «: EdinicyPoslednie(14) = IIf(Валюта = 0, «четырнадцать евро», IIf(Валюта = 1, «четырнадцать рублей», «четырнадцать долларов»))
Edinicy(15) = «пятнадцать «: EdinicyPoslednie(15) = IIf(Валюта = 0, «пятнадцать евро», IIf(Валюта = 1, «пятнадцать рублей», «пятнадцать долларов»))
Edinicy(16) = «шестнадцать «: EdinicyPoslednie(16) = IIf(Валюта = 0, «шестнадцать евро», IIf(Валюта = 1, «шестнадцать рублей», «шестнадцать долларов»))
Edinicy(17) = «семнадцать «: EdinicyPoslednie(17) = IIf(Валюта = 0, «семнадцать евро», IIf(Валюта = 1, «семнадцать рублей», «семнадцать долларов»))
Edinicy(18) = «восемнадцать «: EdinicyPoslednie(18) = IIf(Валюта = 0, «восемнадцать евро», IIf(Валюта = 1, «восемнадцать рублей», «восемнадцать долларов»))
Edinicy(19) = «девятнадцать «: EdinicyPoslednie(19) = IIf(Валюта = 0, «девятнадцать евро», IIf(Валюта = 1, «девятнадцать рублей», «девятнадцать долларов»))
»———————————————
Desyatki(0) = «»: Sotni(0) = «»: tys(0) = «тисячь «: mln(0) = «миллионов «: mlrd(0) = «миллиардов «
Desyatki(1) = «десять «: Sotni(1) = «сто «: tys(1) = «тысяча «: mln(1) = «миллион «: mlrd(1) = «миллиарда «
Desyatki(2) = «двадцать «: Sotni(2) = «двести «: tys(2) = «тысячи «: mln(2) = «миллиона «: mlrd(2) = «миллиарда «
Desyatki(3) = «тридцать «: Sotni(3) = «триста «: tys(3) = «тысячи «: mln(3) = «миллиона «: mlrd(3) = «миллиарда «
Desyatki(4) = «сорок «: Sotni(4) = «четыреста «: tys(4) = «тысячи «: mln(4) = «миллиона «: mlrd(4) = «миллиарда «
Desyatki(5) = «пятьдесят «: Sotni(5) = «пятьсот «: tys(5) = «тысяч «: mln(5) = «миллионов «: mlrd(5) = «миллиардов «
Desyatki(6) = «шестьдесят «: Sotni(6) = «шестьсот «: tys(6) = «тысяч «: mln(6) = «миллионов «: mlrd(6) = «миллиардов «
Desyatki(7) = «семьдесят «: Sotni(7) = «семьсот «: tys(7) = «тысяч «: mln(7) = «миллионов «: mlrd(7) = «миллиардов «
Desyatki(8) = «восемьдесят «: Sotni(8) = «восемьсот «: tys(8) = «тысяч «: mln(8) = «миллионов «: mlrd(8) = «миллиардов «
Desyatki(9) = «девяносто «: Sotni(9) = «девятьсот «: tys(9) = «тысяч «: mln(9) = «миллионов «: mlrd(9) = «миллиардов «
‘———————————————

On Error Resume Next
SumInt = Int(Число)
For x = Len(SumInt) To 1 Step -1
    shag = shag + 1
    Select Case x
        Case 12 ‘ — сотни миллиардов
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 11 ‘ — десятки  миллиардов
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 10 ‘ — единицы  миллиардов
            vl = Mid(SumInt, shag, 1)
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиарда « Else txt = txt & Edinicy(vl) & mlrd(vl) ‘числа в диапозоне от 11 до 19 склоняются на «мільярдов» независимо от последнего числа триады
            Else
                txt = txt & Edinicy(vl) & mlrd(vl)
            End If

‘-КОНЕЦ БЛОКА_______________________

Case 9 ‘ — сотни миллионов
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 8 ‘ — десятки  миллионов
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 7 ‘ — единицы  миллионов
            vl = Mid(SumInt, shag, 1)
            If shag > 2 Then
                If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
            End If
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиона « Else: txt = txt & Edinicy(vl) & mln(vl)  ‘числа в диапозоне от 11 до 19 склоняются на «миллиардов» независимо от последнего числа триады
            Else
                txt = txt & Edinicy(vl) & mln(vl)
            End If
        ‘-КОНЕЦ БЛОКА_______________________

Case 6 ‘ — сотни тысяч
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 5 ‘ — десятки  тысяч
            vl = Mid(SumInt, shag, 1)
            If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 4 ‘ — единицы  тысяч
            vl = Mid(SumInt, shag, 1)
            If shag > 2 Then
                If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
            End If
            Sclon_Tys = Edinicy(vl) & tys(vl) ‘ — вводим переменную Sclon_Tys из-за иного склонения  тысяч в русском языке
            If vl = 1 Then Sclon_Tys = «одна « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную  Sclon_Tys )
            If vl = 2 Then Sclon_Tys = «две « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную  Sclon_Tys )
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag — 1, 2)) & «тисяч «
            End If
            txt = txt & Sclon_Tys

‘-КОНЕЦ БЛОКА_______________________
        Case 3 ‘ — сотни
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 2 ‘ — десятки
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 1 ‘ — единицы
            If Mid(SumInt, shag — 1, 1) <> 1 Or Mid(SumInt, shag — 1, 2) = «10» Then vl = Mid(SumInt, shag, 1) Else vl = Mid(SumInt, shag — 1, 2)
                txt = txt & EdinicyPoslednie(vl)

‘-КОНЕЦ БЛОКА_______________________

End Select
10: Next x
a = Число
b = Int(a)
c = (Round(a — b, 2)) * 100
If c < 10 And c >= 1 Then c = «0» + CStr(c)
If c = 0 Then c = CStr(c) + «0»
d = «»
If Валюта = 1 Then d = «коп.» Else d = «цен.»
If Валюта > 2 Or Валюта < 0 Then MsgBox «Укажите параметр 0-2»
If Валюта > 2 Or Валюта < 0 Then GoTo 11
If Копейки = 0 Then
d = «»
c = «»
End If
If Копейки = 2 Then d = «»
If Копейки > 2 Or Копейи < 0 Then MsgBox «Укажите параметр 0, 1 или 2»
If Копейки > 2 Or Копейки < 0 Then GoTo 11
ЧислоПрописьюВалюта = UCase(Left(txt, 1)) & LCase(Mid(txt, 2)) + » « + CStr(c) + d
11:
End Function

Sub DescribeFunction()
   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1 To 3) As String

FuncName =

«ЧислоПрописьюВалюта»
   FuncDesc = «Функция преобразовывает число суммы текстовыми словами»
   Category = 1 ‘Text category
   ArgDesc(1) = «Исходная сумма»
   ArgDesc(2) = «(необязательный) Тип отображаемой валюты 0-Евро, 1-Рубли, 2-Доллары.»
   ArgDesc(3) = «(необязательный) Нужны ли копейки: 0-нет, 1-отображать копейи стандартно, 2-отображать только дробную часть (без слов).»

   Application.MacroOptions _
      Macro:=FuncName, _
      Description:=FuncDesc, _
      Category:=Category, _
      ArgumentDescriptions:=ArgDesc

End Sub

Также не забудьте добавить в рабочую книгу код вызова макроса регистрации DescribeFunction, чтобы отображать описание атрибутов для пользовательской функции:

Private Sub Workbook_Open()
DescribeFunction
End Sub

Кроме того благодаря данному макросу DescribeFunction функция будет доступна в группе: «ФОРМУЛЫ»-«Библиотека функций»-«Финансовые»-«ЧислоПрописьюВалюта»

Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:

1-рубли;
2-доллары;
0-евро;

Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).

Скачать число прописью в Excel руб RUB.

Украинская версия функции ЧислоСловоВалюта для перевода сумм в гривны находиться в следующем файле:

Скачать функцию ЧислоСловоВалюта ГРН UAH

Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.

Источник