Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сумма прописью в Word - Как допилить? - Страница 2 - Мир MS Excel

Старая форма входа
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Модератор форума: _Boroda_, китин  
Сумма прописью в Word - Как допилить?
AndreTM Дата: Четверг, 31.10.2013, 07:22 | Сообщение № 21
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 501 ±
Замечаний: 0% ±

2003 & 2010
ты бы хоть полный текст процедуры выложил
А это и был полный текст процедуры - достаточно его в sub ... end sub заключить :)
Это что, у вас в бюстгалтерии так принято
О, ты не представляешь, сколько ещё олдскул-спецов попадается. И я их не виню - есть регламенты оформления, которые иногда просто не меняются.
Да и вообще, например, ты платежные поручения видел? Через какой разделитель там копейки? :D
Кроме того, запись суммы "по-русски", через запятую - приводит к ошибкам при преобразовании через Val()/CDbl() - ибо для VBA стандартным разделителем является точка.


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
Сообщение
ты бы хоть полный текст процедуры выложил
А это и был полный текст процедуры - достаточно его в sub ... end sub заключить :)
Это что, у вас в бюстгалтерии так принято
О, ты не представляешь, сколько ещё олдскул-спецов попадается. И я их не виню - есть регламенты оформления, которые иногда просто не меняются.
Да и вообще, например, ты платежные поручения видел? Через какой разделитель там копейки? :D
Кроме того, запись суммы "по-русски", через запятую - приводит к ошибкам при преобразовании через Val()/CDbl() - ибо для VBA стандартным разделителем является точка.

Автор - AndreTM
Дата добавления - 31.10.2013 в 07:22
Алексей Дата: Понедельник, 20.01.2014, 23:09 | Сообщение № 22
Группа: Гости
Самая грамотная тема в интернете по данному вопросу!
Уважаемые камрады, помогите в решении следующего вопроса. У меня много договоров. Как правило суммы в миллионах, иногда в миллиардах, без копеек. Я хотел бы, чтобы, когда я меняю сумму договора, чтобы сумма прописью в скобочках возле числа автоматически переписывалась. Например. Беру я за болванку старый договор, там старая сумма и пропись соответственно тоже, я вписываю новую сумму, в пропись автоматом переписывается, как в excele. Я прошу расписать все как для дебила, потому что я не программист, и мне тяжко сразу врубиться в ньюансы. Хотя макрос AndreTM я запустил и все заработало.
 
Ответить
СообщениеСамая грамотная тема в интернете по данному вопросу!
Уважаемые камрады, помогите в решении следующего вопроса. У меня много договоров. Как правило суммы в миллионах, иногда в миллиардах, без копеек. Я хотел бы, чтобы, когда я меняю сумму договора, чтобы сумма прописью в скобочках возле числа автоматически переписывалась. Например. Беру я за болванку старый договор, там старая сумма и пропись соответственно тоже, я вписываю новую сумму, в пропись автоматом переписывается, как в excele. Я прошу расписать все как для дебила, потому что я не программист, и мне тяжко сразу врубиться в ньюансы. Хотя макрос AndreTM я запустил и все заработало.

Автор - Алексей
Дата добавления - 20.01.2014 в 23:09
Alex_ST Дата: Среда, 22.01.2014, 21:43 | Сообщение № 23
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3213
Репутация: 609 ±
Замечаний: 0% ±

2003
макрос AndreTM я запустил и все заработало

А мой не заработал что ли?
Да и Вы же сами пишете
суммы в миллионах, иногда в миллиардах
а тот, что предложил AndreTM, может только до 999 999

Ну, а сделать в Word'e автоматически пересчитываемые формулы как в Excel'e - это моя давняя и, похоже, несбыточная мечта :(



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
макрос AndreTM я запустил и все заработало

А мой не заработал что ли?
Да и Вы же сами пишете
суммы в миллионах, иногда в миллиардах
а тот, что предложил AndreTM, может только до 999 999

Ну, а сделать в Word'e автоматически пересчитываемые формулы как в Excel'e - это моя давняя и, похоже, несбыточная мечта :(

Автор - Alex_ST
Дата добавления - 22.01.2014 в 21:43
Алексей Дата: Пятница, 24.01.2014, 13:26 | Сообщение № 24
Группа: Гости
Я сначала с Вашим пытался. у меня не получилось. Я видимо, что-то перепутал, так как не разобрался, как из двух Ваших постов сделать один макрос.
А макрос AndreTM успешно сделал мне 16550200.
Жаль, что нельзя сделать автоматическое пересчитывание.
 
Ответить
СообщениеЯ сначала с Вашим пытался. у меня не получилось. Я видимо, что-то перепутал, так как не разобрался, как из двух Ваших постов сделать один макрос.
А макрос AndreTM успешно сделал мне 16550200.
Жаль, что нельзя сделать автоматическое пересчитывание.

Автор - Алексей
Дата добавления - 24.01.2014 в 13:26
Alex_ST Дата: Вторник, 29.04.2014, 14:42 | Сообщение № 25
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3213
Репутация: 609 ±
Замечаний: 0% ±

2003
Специально для metrolog, задавшего вопрос не в той теме, и для других малоопытных написал инструкцию.
В стандартном модуле шаблона Normal.dot прописываете процедуры:[vba]
Код
Sub ПРОПИСЬЮ()
'---------------------------------------------------------------------------------------
' Procedure    : ПРОПИСЬЮ
' Author       : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL    : http://www.excelworld.ru/forum/4-6947-1
' DateTime     : 29.10.2013, 17:19
' Purpose      : цифры из выделенного текста перевести в число прописью и вставить после выделения
' Notes        :
'---------------------------------------------------------------------------------------
       If Selection.Type <> wdSelectionNormal Then Exit Sub
       Dim NNN
       With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\D": NNN = .Replace(Selection.Range.Text, ""): End With
       'If Len(NNN) Then Selection.MoveRight Unit:=wdWord: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
       If Len(NNN) Then Selection.Start = Selection.End: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
End Sub
'-------------------------------------------------------------------------------------------------------------------------------------------  ------------
Function СУМ_ПРОП$(ByVal ЧИСЛО#)   ' http://www.excelworld.ru/forum/3-9902-1 Author MCH (Михаил Ч.), май 2012
       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.00"), 15)
       kop = Right(Format(ЧИСЛО, "0.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
       СУМ_ПРОП = UCase(Left(m, 1)) & Mid(m, 2)
End Function
[/vba]
После этого на листе выделяете выделяете цифры и вызываете макрос ПРОПИСЬЮ



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Вторник, 29.04.2014, 14:49
 
Ответить
СообщениеСпециально для metrolog, задавшего вопрос не в той теме, и для других малоопытных написал инструкцию.
В стандартном модуле шаблона Normal.dot прописываете процедуры:[vba]
Код
Sub ПРОПИСЬЮ()
'---------------------------------------------------------------------------------------
' Procedure    : ПРОПИСЬЮ
' Author       : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL    : http://www.excelworld.ru/forum/4-6947-1
' DateTime     : 29.10.2013, 17:19
' Purpose      : цифры из выделенного текста перевести в число прописью и вставить после выделения
' Notes        :
'---------------------------------------------------------------------------------------
       If Selection.Type <> wdSelectionNormal Then Exit Sub
       Dim NNN
       With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\D": NNN = .Replace(Selection.Range.Text, ""): End With
       'If Len(NNN) Then Selection.MoveRight Unit:=wdWord: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
       If Len(NNN) Then Selection.Start = Selection.End: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
End Sub
'-------------------------------------------------------------------------------------------------------------------------------------------  ------------
Function СУМ_ПРОП$(ByVal ЧИСЛО#)   ' http://www.excelworld.ru/forum/3-9902-1 Author MCH (Михаил Ч.), май 2012
       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.00"), 15)
       kop = Right(Format(ЧИСЛО, "0.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
       СУМ_ПРОП = UCase(Left(m, 1)) & Mid(m, 2)
End Function
[/vba]
После этого на листе выделяете выделяете цифры и вызываете макрос ПРОПИСЬЮ

Автор - Alex_ST
Дата добавления - 29.04.2014 в 14:42
metrolog Дата: Среда, 30.04.2014, 12:04 | Сообщение № 26
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Alex_ST, записал Ваш макрос. При попытке выполнить его, выдает ошибку. Помогите её устранить пожалуйста))) Скрин ошибки прилагаю
К сообщению приложен файл: Error.rar (89.8 Kb)
 
Ответить
СообщениеAlex_ST, записал Ваш макрос. При попытке выполнить его, выдает ошибку. Помогите её устранить пожалуйста))) Скрин ошибки прилагаю

Автор - metrolog
Дата добавления - 30.04.2014 в 12:04
RAN Дата: Среда, 30.04.2014, 12:19 | Сообщение № 27
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Сравните
[vba]
Код
If Len(NNN) Then Selection.Start = Selection.End: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
[/vba]
и стоку на вашей картинке


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеСравните
[vba]
Код
If Len(NNN) Then Selection.Start = Selection.End: Selection.Range.Text = " (" & СУМ_ПРОП(NNN) & ") "
[/vba]
и стоку на вашей картинке

Автор - RAN
Дата добавления - 30.04.2014 в 12:19
metrolog Дата: Среда, 30.04.2014, 12:24 | Сообщение № 28
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Прошу прощения, разобрался сам hands
Похоже я начал понимать что и как!!!
 
Ответить
СообщениеПрошу прощения, разобрался сам hands
Похоже я начал понимать что и как!!!

Автор - metrolog
Дата добавления - 30.04.2014 в 12:24
Рaмиля Дата: Понедельник, 28.12.2015, 11:43 | Сообщение № 29
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Уважаемый Alex_ST! Макрос, предложенный Вами, сумму в рублях 8309931,01 выдает в виде "(Восемьсот тридцать миллионов девятьсот девяносто три тысячи двести один )". Помогите разобраться с ошибкой!


Сообщение отредактировал рамиля - Понедельник, 28.12.2015, 11:50
 
Ответить
СообщениеУважаемый Alex_ST! Макрос, предложенный Вами, сумму в рублях 8309931,01 выдает в виде "(Восемьсот тридцать миллионов девятьсот девяносто три тысячи двести один )". Помогите разобраться с ошибкой!

Автор - Рaмиля
Дата добавления - 28.12.2015 в 11:43
krosav4ig Дата: Понедельник, 28.12.2015, 18:25 | Сообщение № 30
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
рамиля, замените в коде
Код
"\D"
на
Код
"[^\d,]"


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениерамиля, замените в коде
Код
"\D"
на
Код
"[^\d,]"

Автор - krosav4ig
Дата добавления - 28.12.2015 в 18:25
Рaмиля Дата: Вторник, 29.12.2015, 08:07 | Сообщение № 31
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Спасибо krosav4ig! Замену в коде сделала! Целая часть считывается правильно. Но, что нужно поменять в коде для считывания в виде "Восемь миллионов триста девять тысяч девятьсот тридцать два рубля 01 копейка"?


Сообщение отредактировал рамиля - Вторник, 29.12.2015, 08:32
 
Ответить
СообщениеСпасибо krosav4ig! Замену в коде сделала! Целая часть считывается правильно. Но, что нужно поменять в коде для считывания в виде "Восемь миллионов триста девять тысяч девятьсот тридцать два рубля 01 копейка"?

Автор - Рaмиля
Дата добавления - 29.12.2015 в 08:07
RAN Дата: Вторник, 29.12.2015, 11:07 | Сообщение № 32
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
В функции из сообщения 25 вывод копеек отключен.
Используйте полный вариант функции (сообщение 4)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеВ функции из сообщения 25 вывод копеек отключен.
Используйте полный вариант функции (сообщение 4)

Автор - RAN
Дата добавления - 29.12.2015 в 11:07
iam_alex Дата: Четверг, 08.12.2016, 13:08 | Сообщение № 33
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Друзья, подскажите, можно ли внести изменения в макрос так, чтобы в конце не было пробела перед скобкой?
Например 1'000: получается (Одна тысяча ), хотелось бы (Одна тысяча)
Заранее спасибо)

использую из сообщения 25


Сообщение отредактировал iam_alex - Четверг, 08.12.2016, 13:08
 
Ответить
СообщениеДрузья, подскажите, можно ли внести изменения в макрос так, чтобы в конце не было пробела перед скобкой?
Например 1'000: получается (Одна тысяча ), хотелось бы (Одна тысяча)
Заранее спасибо)

использую из сообщения 25

Автор - iam_alex
Дата добавления - 08.12.2016 в 13:08
krosav4ig Дата: Четверг, 08.12.2016, 14:38 | Сообщение № 34
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
iam_alex, [vba]
Код
UCase(Left(m, 1)) & Mid(m, 2)
[/vba] замените на [vba]
Код
RTrim(UCase(Left(m, 1)) & Mid(m, 2))
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеiam_alex, [vba]
Код
UCase(Left(m, 1)) & Mid(m, 2)
[/vba] замените на [vba]
Код
RTrim(UCase(Left(m, 1)) & Mid(m, 2))
[/vba]

Автор - krosav4ig
Дата добавления - 08.12.2016 в 14:38
iam_alex Дата: Четверг, 08.12.2016, 15:28 | Сообщение № 35
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
krosav4ig, спасибо!!!
 
Ответить
Сообщениеkrosav4ig, спасибо!!!

Автор - iam_alex
Дата добавления - 08.12.2016 в 15:28
Manyasha Дата: Понедельник, 16.01.2017, 12:46 | Сообщение № 36
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 901 ±
Замечаний: 0% ±

Excel 2010, 2016
Naminator, оформите код тегами (кнопка #)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеNaminator, оформите код тегами (кнопка #)

Автор - Manyasha
Дата добавления - 16.01.2017 в 12:46
Naminator Дата: Вторник, 17.01.2017, 17:18 | Сообщение № 37
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Исправил под свою задачу.
Сумму необходимо вводить с копейками, копейки указывать в двухзначном формате!
Строка "1201" либо "120,1" либо "12,01" преобразуется одинаково в "12 рублей 01 копейку", т.е. макрос удаляет все разделительные знаки,
затем последние два числа берет как копейки, остальное - рубли.
Максимальное значение 999999999999999,99 (999 триллионов)

Пример:
выделяем 12887,03руб., результат (Двенадцать тысяч восемьсот восемьдесят семь) рублей 03 копейки

[vba]
Код

Sub ПРОПИСЬЮ()
'---------------------------------------------------------------------------------------
' Procedure    : ПРОПИСЬЮ
' Author       : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL    : http://www.excelworld.ru/forum/4-6947-1
' DateTime     : 29.10.2013, 17:19
' Purpose      : цифры из выделенного текста перевести в число прописью и вставить после выделения
' Notes        : Копейки вводить обязательно в двухзначном формате т.к. они берутся из расчета последние 2 числа
' Пример       : Строка "1201" либо "120,1" либо "12,01" преобразуется одинаково в "12 рублей 01 копейку"
'---------------------------------------------------------------------------------------
    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 ЧИСЛОКОП#)  ' http://www.excelworld.ru/forum/3-9902-1 Author MCH (Михаил Ч.), май 2012
    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)
    СУМ_ПРОП = UCase(Left(m, 1)) & Mid(m, 2) & kop & " копе" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ек", IIf(kop Mod 10 = 1, "йка", "йки"))
End Function
[/vba]
 
Ответить
СообщениеИсправил под свою задачу.
Сумму необходимо вводить с копейками, копейки указывать в двухзначном формате!
Строка "1201" либо "120,1" либо "12,01" преобразуется одинаково в "12 рублей 01 копейку", т.е. макрос удаляет все разделительные знаки,
затем последние два числа берет как копейки, остальное - рубли.
Максимальное значение 999999999999999,99 (999 триллионов)

Пример:
выделяем 12887,03руб., результат (Двенадцать тысяч восемьсот восемьдесят семь) рублей 03 копейки

[vba]
Код

Sub ПРОПИСЬЮ()
'---------------------------------------------------------------------------------------
' Procedure    : ПРОПИСЬЮ
' Author       : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL    : http://www.excelworld.ru/forum/4-6947-1
' DateTime     : 29.10.2013, 17:19
' Purpose      : цифры из выделенного текста перевести в число прописью и вставить после выделения
' Notes        : Копейки вводить обязательно в двухзначном формате т.к. они берутся из расчета последние 2 числа
' Пример       : Строка "1201" либо "120,1" либо "12,01" преобразуется одинаково в "12 рублей 01 копейку"
'---------------------------------------------------------------------------------------
    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 ЧИСЛОКОП#)  ' http://www.excelworld.ru/forum/3-9902-1 Author MCH (Михаил Ч.), май 2012
    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)
    СУМ_ПРОП = UCase(Left(m, 1)) & Mid(m, 2) & kop & " копе" & IIf(kop \ 10 = 1 Or ((kop + 9) Mod 10) >= 4, "ек", IIf(kop Mod 10 = 1, "йка", "йки"))
End Function
[/vba]

Автор - Naminator
Дата добавления - 17.01.2017 в 17:18
Alex_ST Дата: Вторник, 17.01.2017, 22:34 | Сообщение № 38
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3213
Репутация: 609 ±
Замечаний: 0% ±

2003
' Author : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL : http://www.excelworld.ru/forum/4-6947-1
' DateTime : 29.10.2013, 17:19

' Author : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL : http://www.excelworld.ru/forum/4-6947-1
' DateTime : 29.10.2013, 17:19
Naminator, ну Вы бы хоть заголовок процедуры правили. Я к Вашим доработкам никакого отношения не имею, адреса топиков не те, даты тоже.



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
' Author : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL : http://www.excelworld.ru/forum/4-6947-1
' DateTime : 29.10.2013, 17:19

' Author : Alex_ST
' Topic_HEADER : Сумма прописью в Word - Как допилить? (Word)
' Topic_URL : http://www.excelworld.ru/forum/4-6947-1
' DateTime : 29.10.2013, 17:19
Naminator, ну Вы бы хоть заголовок процедуры правили. Я к Вашим доработкам никакого отношения не имею, адреса топиков не те, даты тоже.

Автор - Alex_ST
Дата добавления - 17.01.2017 в 22:34
карандаш Дата: Понедельник, 13.02.2017, 08:00 | Сообщение № 39
Группа: Проверенные
Ранг: Обитатель
Сообщений: 329
Репутация: 8 ±
Замечаний: 0% ±

2010
есть такое решение


надо указателем встать на число (текст, состоящий из цифр, разделённых пробелом, неразрвным пробелом, штрихом, запятой) и кликнуть по кнопке макроса в шапке ворда (кнопку поставить туда через настройку ленты)


Сообщение отредактировал карандаш - Понедельник, 13.02.2017, 08:04
 
Ответить
Сообщениеесть такое решение


надо указателем встать на число (текст, состоящий из цифр, разделённых пробелом, неразрвным пробелом, штрихом, запятой) и кликнуть по кнопке макроса в шапке ворда (кнопку поставить туда через настройку ленты)

Автор - карандаш
Дата добавления - 13.02.2017 в 08:00
Рамиля Дата: Понедельник, 13.02.2017, 08:49 | Сообщение № 40
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Карандаш!
Цитата карандаш, 13.02.2017 в 08:00, в сообщении № 39 ()
надо указателем встать на число

Здравствуйте! Макрос выводит прописью,но без копеек.
 
Ответить
СообщениеКарандаш!
Цитата карандаш, 13.02.2017 в 08:00, в сообщении № 39 ()
надо указателем встать на число

Здравствуйте! Макрос выводит прописью,но без копеек.

Автор - Рамиля
Дата добавления - 13.02.2017 в 08:49
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!