Форум программистов, компьютерный форум, киберфорум
MS Office Word
Войти
Регистрация
Восстановить пароль
 
0 / 0 / 0
Регистрация: 02.10.2019
Сообщений: 3
1

Сумма прописью WORD, допилить макрос WORD

04.06.2020, 15:18. Просмотров 104. Ответов 0
Метки нет (Все метки)

Добрый день, макрос в normal.dot пишет сумму 100000,00 видом (сто тысяч) рублей 00 копеек
Помогите реализовать запись с дубрилованием суммы с разделением пробелом разрядов (тысяч, миллионов)

Образец:
Сумма: 100000,00 Пропись: 100 000 (сто тысяч) рублей 00 копеек

Кликните здесь для просмотра всего текста

Sub Прописью()
If Selection.Type <> wdSelectionNormal Then Exit Sub
Dim NNN, NNNOst, NNNLen
With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\D": NNN = .Replace(Selection.Range.Text, ""): End With
NNNLen = Len(NNN)
If NNNLen > 17 Then Exit Sub
NNNOst = Format(Right(NNN, 2), "00", 2)
If NNNLen > 2 Then NNN = Left(NNN, NNNLen - 2) Else NNN = 0
' NNN = NNN & "," & NNNOst
If Len(NNN) Then Selection.Start = Selection.End: Selection.Range.Text = " (" & СУМ_ПРОП(NNN, NNNOst)
End Sub
Function СУМ_ПРОП$(ByVal ЧИСЛО#, ByVal ЧИСЛОКОП#)
Dim rub$, kop$, ed, des, sot, nadc, RAZR, i&, m$
If ЧИСЛО >= 1E+15 Or ЧИСЛО < 0 Then Exit Function
sot = Array("", " сто", " двести", " триста", " четыреста", " пятьсот", " шестьсот", " семьсот", " восемьсот", " девятьсот")
des = Array("", "", " двадцать", " тридцать", " сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят", " девяносто")
nadc = Array(" десять", " одиннадцать", " двенадцать", " тринадцать", " четырнадцать", " пятнадцать", " шестнадцать", " семнадцать", " восемнадцать", " девятнадцать")
ed = Array("", " один", " два", " три", " четыре", " пять", " шесть", " семь", " восемь", " девять", "", " одна", " две")
RAZR = Array(" триллион", " триллиона", " триллионов", " миллиард", " миллиарда", " миллиардов", " миллион", " миллиона", " миллионов", " тысяча", " тысячи", " тысяч", ") рубль ", ") рубля ", ") рублей ")
rub = Left(Format(ЧИСЛО, "000000000000000"), 15)
kop = Left(Format(ЧИСЛОКОП, "00"), 2)
If CDbl(rub) = 0 Then m = " ноль"
For i = 1 To Len(rub) Step 3
If Mid(rub, i, 3) <> "000" Or i = Len(rub) - 2 Then
m = m & sot(CInt(Mid(rub, i, 1))) & IIf(Mid(rub, i + 1, 1) = "1", nadc(CInt(Mid(rub, i + 2, 1))), _
des(CInt(Mid(rub, i + 1, 1))) & ed(CInt(Mid(rub, i + 2, 1)) + IIf(i = Len(rub) - 5 And CInt(Mid(rub, i + 2, 1)) < 3, 10, 0))) & _
IIf(Mid(rub, i + 1, 1) = "1" Or (Mid(rub, i + 2, 1) + 9) Mod 10 >= 4, RAZR(i + 1), IIf(Mid(rub, i + 2, 1) = "1", RAZR(i - 1), RAZR(i)))
End If
Next i
m = LTrim(m)
СУМ_ПРОП = RTrim(Left(m, 1)) & Mid(m, 2) & kop & " копе" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ек", IIf(kop Mod 10 = 1, "йка", "йки"))
End Function


Добавлено через 1 час 4 минуты
Закрыто
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
04.06.2020, 15:18
Ответы с готовыми решениями:

Макрос Word 2016 замена шрифта рандомных символов на выбранный - MS Word
Есть обычный текст, только буквы и цифры Нужно, чтобы после обработки макроса выбирались случайные...

Нужен макрос для WORD = сравнение ячеек двух столбцов таблиц, расположенных в разных документах WORD
Здравствуйте, Нужен макрос для WORD = сравнение ячеек двух столбцов таблиц, расположенных в разных...

Макрос в Word
Создать процедуру, которая в заданном документе все сочетания «Фамилия – инициалы» преобразует к...

Word.Application. Взаимодействие с word. Добавить общие шаблоны *.dot в папку appdata и в word
Добрый день! Подскажите, пожалуйста, возможно ли средствами делфи активировать кнопку &quot;Добавить&quot;...

0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
04.06.2020, 15:18

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

Сделать макрос в Word, вводишь строку и макрос произвольно меняет шрифт, цвет и размер для каждого слова из этого активного вордовского документа.
Началось VBA - лекций нет, только практика. Препод категоричеки отказывается что-нить объяснять,...

Макрос WORD
Здравствуйте))) Помогите пожалуйста с макросом для WORD, каждый месяц делаю одну и туже работу,...

Макрос в Word'е
Всем доброго времени суток. Ситуация такова: есть документ со строками типа то-есть протокол...

Макрос в Word
Как получить такую форму?

Макрос Word
Есть несколько гигантских текстов, в них нужно заменить по три-четыре фразы. Нужна замена наподобие...

Макрос в MO Word
Помогите пожалуйста! Очень нужна ваша помощь,нужен макрос в MO Word (2003 или 2007), который...


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

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.