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

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

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

Author24 — интернет-сервис помощи студентам
Макрос прописывает число вида 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)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
29.06.2019, 15:43
Ответы с готовыми решениями:

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

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

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

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

21
Часто онлайн
903 / 609 / 272
Регистрация: 09.01.2017
Сообщений: 2,012
02.07.2019, 09:55 21
Author24 — интернет-сервис помощи студентам
fever brain, закралась ошибка в строке 37 кода из поста 14(я полагаю вы именно этот код использовали)

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

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

Не по теме:

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

0
02.07.2019, 10:25
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
02.07.2019, 10:25
Помогаю со студенческими работами здесь

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

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

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

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


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

Или воспользуйтесь поиском по форуму:
22
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru