Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.65/34: Рейтинг темы: голосов - 34, средняя оценка - 4.65
0 / 0 / 0
Регистрация: 04.02.2018
Сообщений: 20
Word

Сумма чисел прописью

29.06.2019, 15:43. Показов 8120. Ответов 21
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Макрос прописывает число вида 55 прописью (пятьдесят пять руб. 00 копеек), как изменить код что бы копейки были тоже буквами?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Public Function funSupr(xsu As Variant, Optional mb As Byte) As String
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
funSupr = ""
Exit Function
End If
If xsu >= 10000000000000# Then
funSupr = "слишком большое число"
Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
funSupr = "ноль рублей "
Else
ssu = Mid$(str$(Fix(xsu)), 2) ' строка рублей без знака
nsu = (Len(ssu) + 2) \ 3 ' количество троек цифр
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu ' добавляем нулями
For i = nsu To 1 Step -1
sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1)) ' сотни
des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1)) ' десятки
edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1)) ' единицы
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
funSupr = funSupr + Choose(sot, "сто", "двести", "триста", _
"четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
"девятьсот") + " "
End If
If des = 1 Then
funSupr = funSupr + Choose(edi + 1, "десять", "одиннадцать", _
"двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
"семнадцать", "восемнадцать", "девятнадцать") + " "
ind = 3
Else
If des <> 0 Then
funSupr = funSupr + Choose(des - 1, "двадцать", _
"тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _
"девяносто") + " "
End If
If edi <> 0 Then ' вычисляем индекс для тысяч (одна,две)
If i = 2 And (edi = 1 Or edi = 2) Then
ind = 9
Else
ind = 0
End If
funSupr = funSupr + Choose(edi + ind, "один", "два", _
"три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _
"две") + " "
End If
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + Choose((i - 1) * 3 + ind, "рубль", "рубля", "рублей", _
"тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _
"миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _
"триллионов") + " "
End If
Next i
End If
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + ssu + Choose(ind, " копейка", " копейки", " копеек")
If mb = 0 Then
funSupr = UCase$(Left$(funSupr, 1)) + Mid$(funSupr, 2)
End If
Exit Function
ersupr:
funSupr = "ошибка"
End Function
 
 
Sub ЧислоПрописью2()
Dim Summa$
Summa$ = funSupr(Selection.Text, 1)
If Summa$ <> "" Then ' допустимое значение
Selection.Text = Selection.Text + " (" + Summa$ + ") "
End If
End Sub
0
Лучшие ответы (1)
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
29.06.2019, 15:43
Ответы с готовыми решениями:

Дата прописью и сумма прописью
Господа, помогите!! Перерыл весь инет, скачал кучу прог и кодов но не разобрался ни в чем..(( Мне нужно чтоб в Excel я писал в одной...

Сумма прописью
Дано натуральное число n. n&lt;=1000 Записать это число русскими словами...

Сумма прописью для счета
Здравствуйте, это второй мой вопрос на эту тему)) В общем есть некий файл, там формируется счет и нужно, чтобы автоматически считалось...

21
Часто онлайн
 Аватар для КостяФедореев
987 / 637 / 280
Регистрация: 09.01.2017
Сообщений: 2,080
02.07.2019, 09:55
Студворк — интернет-сервис помощи студентам
fever brain, закралась ошибка в строке 37 кода из поста 14(я полагаю вы именно этот код использовали)

Visual Basic
1
frPart = Right$(Format(Сумма, "0.00"), 2)
и я об этом писал в том же посте.
0
oh my god
 Аватар для fever brain
1456 / 796 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
02.07.2019, 10:25
Цитата Сообщение от КостяФедореев Посмотреть сообщение
я полагаю вы именно этот код использовали
Я проверил два выложенных варианта.
6 и 14 -пост. Любой кто будет заходить по поиску первым делом найдут лучший ответ, и скопируют код к себе
мало кто будет смотреть на коментарии в посте. Я кстати тоже их не читал.
А вообще тема устаревшая, и давно решенная. Ниже на этой странице есть подсказки на похожие темы

Добавлено через 2 минуты

Не по теме:

Лично я написал код заново из личных интересов, давно не программировал, решил вспомнить что это такое ))

0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
02.07.2019, 10:25

Сумма прописью RUR USD и EUR
Помогите плиз.... нужно в excele 2003 переводить числа прописью в разных валютах и просто числа

Сумма прописью для меняющейся ячейки
Всем доброго времени суток! В приложенном файле представлен вариант суммы прописью, если координаты ячейки не меняются. Вопрос –...

Сумма прописью: переписать код под VBA
Вот нашла код многоуважаемого Бурундука, для аксеса: Static one(0 To 19, 1 To 2) As String, ten(0 To 9) As String, hun(0 To 9) As...

Записать число 123 - "сто двадцать три" (сумма прописью)
Вот задача: Дано целое число в диапазоне 100–999. Вывести строку-описание данного числа, например: 256 — «двести пятьдесят шесть», 814...

Макрос "сумма прописью"
Добрый вечер! Просьба, помочь в редактировании макроса &quot;сумма прописью&quot;. Нужно чтобы текст вида &quot;Одна тысяча сто одиннадцать...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
22
Ответ Создать тему
Новые блоги и статьи
Копировать Windows на новый диск на UEFI
damix 17.10.2026
https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .
ИИ не может найти нужный язык в списке
Supersumestria 05.10.2026
Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO
zorxor 05.10.2026
Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .
Программный домашний кинотеатр
russiannick 27.09.2026
Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого
zorxor 21.09.2026
Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru