Vba word сумма прописью

Сумма прописью в Word — Как допилить?

Alex_ST

 Дата: Понедельник, 28.10.2013, 15:26 |
Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Народ, тут понадобилось договора писать, а там сумма прописью…
Можно было бы, конечно, и имеющимися наработками для Excel’я воспользоваться, но я у себя в копилке нашёл, что числа до 999999 можно в текст прямо Вордом перегонять (например, здесь, здесь, здесь, …).
Решил попробовать.
Вот что примерно получилось:[vba]

Код

Sub SumPropWord()
       With Selection
          ‘.Range.Text = Replace(.Range.Text, » «, «»)
          .Fields.Add .Range, Type:=wdFieldEmpty, Text:=»=» & .Range.Text & » *CardText», PreserveFormatting:=False
          .Fields.Update
       End With
End Sub

[/vba]
И всё бы, наверное, и ничего, да вот только триады цифр в документе для читабельности обычно разбиваются пробелом. А с пробелами не пашет.
Попытался тупо заменить пробел на «пустышку» Replace’ом в Selection.Range.Text — не вышло — макрос стал давать ошибку в формуле…
Я объектную модель Ворда практически не знаю. Тыкаю почти наугад по аналогии с Excel’ем :(
Конечно, идеалом было бы допилить макрос так, чтобы он ПОСЛЕ (а не ВМЕСТО) выделенного числа выдавал его же прописью, но это уже не так важно.


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

Сообщение отредактировал Alex_ST — Понедельник, 28.10.2013, 16:33
 

Ответить

Poltava

 Дата: Понедельник, 28.10.2013, 18:31 |
Сообщение № 2

Группа: Друзья

Ранг: Форумчанин

Сообщений: 232


Репутация:
50
±

Замечаний:
0% ±


У меня такая конструкция срабатывает нормально
[vba]

Код

Text:=»=» & Replace(.Range.Text, » «, «») & » *CardText»

[/vba]
А вот со вставкой после пока ничего не придумал сам с вердом на Вы
 

Ответить

Alex_ST

 Дата: Понедельник, 28.10.2013, 21:04 |
Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

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


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

Сообщение отредактировал Alex_ST — Вторник, 29.10.2013, 14:40
 

Ответить

RAN

 Дата: Вторник, 29.10.2013, 05:15 |
Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Леш, может я что не так понял?
[vba]

Код

Sub SumPropWord()
    Dim aa#
     With Selection
         aa = CDbl(Replace(Replace(.Range.Text, Chr(160), «»), » «, «»))
         .Range.Text = .Range.Text & » » & MSumProp(aa)
     End With
End Sub
Function MSumProp$(chislo#) ‘Автор MCH (Михаил Ч.), май 2012
Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
If chislo >= 1E+15 Or chislo < 0 Then Exit Function

sot = Array(«», «сто «, «двести «, «триста «, «четыреста «, «пятьсот «, «шестьсот «, «семьсот «, «восемьсот «, «девятьсот «)
des = Array(«», «», «двадцать «, «тридцать «, «сорок «, «пятьдесят «, «шестьдесят «, «семьдесят «, «восемьдесят «, «девяносто «)
nadc = Array(«десять «, «одиннадцать «, «двенадцать «, «тринадцать «, «четырнадцать «, «пятнадцать «, «шестнадцать «, «семнадцать «, «восемнадцать «, «девятнадцать «)
ed = Array(«», «один «, «два «, «три «, «четыре «, «пять «, «шесть «, «семь «, «восемь «, «девять «, «», «одна «, «две «)
razr = Array(«триллион «, «триллиона «, «триллионов «, «миллиард «, «миллиарда «, «миллиардов «, «миллион «, «миллиона «, «миллионов «, «тысяча «, «тысячи «, «тысяч «, «рубль «, «рубля «, «рублей «)

rub = Left(Format(chislo, «000000000000000.00»), 15)
kop = Right(Format(chislo, «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
MSumProp = 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]

Быть или не быть, вот в чем загвоздка!

 

Ответить

anvg

 Дата: Вторник, 29.10.2013, 05:52 |
Сообщение № 5

Группа: Друзья

Ранг: Ветеран

Сообщений: 581


Репутация:
271
±

Замечаний:
0% ±


2016, 365

Видимо хочется средствами Word осуществить перевод числа в сумму прописью.
[vba]

Код

Public Sub test3()
      Dim pReg As Object
      Dim numField As Field
      Dim numText As String

              If Selection.Characters.Count > 1 Then
          Set pReg = CreateObject(«VBScript.RegExp»)
          pReg.Global = True: pReg.Pattern = «[^d]+»
          numText = pReg.Replace(Selection.Text, «»)
          If Len(numText) > 0 Then
              Selection.MoveRight Count:=1
              Selection.TypeText » »
              Set numField = Selection.Fields.Add(Selection.Range, wdFieldEmpty, «=» & numText & «*CardText», False)
              numField.Update
          End If
      End If
End Sub

[/vba]

Сообщение отредактировал anvg — Вторник, 29.10.2013, 05:53
 

Ответить

AndreTM

 Дата: Вторник, 29.10.2013, 06:25 |
Сообщение № 6

Группа: Друзья

Ранг: Старожил

Сообщений: 1762


Репутация:
498
±

Замечаний:
0% ±


2003 & 2010

Ну, понятное дело, что средствами Word. Можно и чистыми:
[vba]

Код

With Selection
     .MoveStartWhile «0123456789 » & Chr(160), wdBackward
     .MoveEndWhile «0123456789 » & Chr(160), wdForward
     nValue1 = Val(Replace(Replace(.Text, » «, «»), Chr(160), «»))

           nShift = .MoveEndWhile(«0123456789.,-=», wdForward)
     nValue2 = IIf(nShift > 0, Val(Right(.Text, nShift — 1)), 0)
     .Start = .End
     .TypeText » (»
     .Fields.Add .Range, wdFieldEmpty, «=» & nValue1 & » * CardText * FirstCap», True
     .TypeText » руб. » & Format(nValue2, «00») & » коп.)»
End With

[/vba] :D

Skype: andre.tm.007
Donate: Qiwi: 9517375010

 

Ответить

Fairuza

 Дата: Вторник, 29.10.2013, 10:46 |
Сообщение № 7

Группа: Проверенные

Ранг: Участник

Сообщений: 57


Репутация:
13
±

Замечаний:
0% ±


А если пробел заменить на неразрывный пробел, тогда код поля *CardText работает
 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 13:26 |
Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Народ, спасибо за отзывы.
К сожалению, уже опять меня настиг завал на работе и разбираться совершенно некогда.
А внутренние средства Ворда я для того применил, т.к. была задумка чтобы сумма прописью вводилась макросом как поле, вычисляемое по сумме цифрами, которую можно было бы потом спокойно изменять в ручную (ну как у нас, нормальных :) в Excel’e формула, использующая UDF).

Хотя всё-таки не удержался и проверил вариант от RAN
Андрей! Спасибо большое. Отлично работает!


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

 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 13:36 |
Сообщение № 9

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

AndreTM,
на строке [vba]

Код

nValue2 = IIf(nShift > 0, Val(Right(.Text, nShift — 1)), 0)

[/vba]даёт инвалид-аргумент при выделенном 123456 на листе :(
[offtop]А объектную модель-то Ворда, оказывается кто-то всё-таки знает…
Столько абсолютно ничего не говорящих мне свойств, методов и параметров в коде![/offtop]


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

Сообщение отредактировал Alex_ST — Вторник, 29.10.2013, 13:36
 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 16:28 |
Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

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


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

Сообщение отредактировал Alex_ST — Вторник, 29.10.2013, 16:29
 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 17:04 |
Сообщение № 11

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Хотя, с буфером обмена — это, пожалуй, лишнее.
Лучше будет в скобочках после выделения выводить так:
[vba]

Код

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) & «) »
End Sub

[/vba]


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

Сообщение отредактировал Alex_ST — Вторник, 29.10.2013, 17:19
 

Ответить

RAN

 Дата: Вторник, 29.10.2013, 21:36 |
Сообщение № 12

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Економный ты наш!
Я понимаю, что тут все преобразуется
[vba][/vba]
Но что, сразу написать
[vba][/vba]
так сильно влом?

Из опыта — долго искал (в большом макросе), почему не работает. Оказалось — преобразовывает не правильно.

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN — Вторник, 29.10.2013, 21:38
 

Ответить

AndreTM

 Дата: Вторник, 29.10.2013, 22:18 |
Сообщение № 13

Группа: Друзья

Ранг: Старожил

Сообщений: 1762


Репутация:
498
±

Замечаний:
0% ±


2003 & 2010

инвалид-аргумент при выделенном 123456 на листе

А если не выделять ничего? Просто курсор поставить «посреди» числа?
Я больше ориентировался на то, чтобы не заставлять пользователя выделять число (и ещё обычно при ручном выделении дефолтный Expand срабатывает, расширяя область выделения по своему разумению).

По ошибке — это Word VBA, гад, всё равно считает в Left(,-1) в IIF() … можно сделать
[vba]

Код

     nValue2 = 0
      If nShift > 1 Then nValue2 = Val(Right(.Text, nShift — 1))

[/vba]

Что касается «сумма вводилась как поле» — она и так вводится в поле. Поэтому, кстати, исходный вариант и предполагал замену текста полем, чтобы число оставалось единственным. А чтобы можно было «менять сумму», не заходя в поле — надо либо текст преобразовать в поле с меткой (закладкой), на которую потом будет ссылаться сумма прописью, либо отслеживать изменение текста и перезаписывать/пересоздавать поле с прописью.
Ещё хочу заметить — .MoveRight Unit:=wdWord сдвинет точку ввода хоть и на конец цифр — но там может стоять разделитель :) Например, сумма записана (как это любят бухи) «123456=00» — тогда что? Да и число может быть «Ноль» (например, остаток суммы оплаты)…

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Сообщение отредактировал AndreTM — Вторник, 29.10.2013, 22:24
 

Ответить

RAN

 Дата: Вторник, 29.10.2013, 22:33 |
Сообщение № 14

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Интересная тема, жаль не вовремя (для меня) начатая. :(
Не забыть-бы, когда понадобиться.

Быть или не быть, вот в чем загвоздка!

 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 23:04 |
Сообщение № 15

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Андрей,
я специально сделал NNN безразмерным чтобы потом ему же можно было присваивать и текстовые значения:[vba]

Код

NNN = IIf(Err, Err.Description, СУМ_ПРОП(NNN)

[/vba]
Да и вообще я потом по-другому сделал без обработчика ошибок.


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

 

Ответить

Alex_ST

 Дата: Вторник, 29.10.2013, 23:08 |
Сообщение № 16

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Не забыть-бы, когда понадобиться

А ты на ус намотай (или на хвост) :)


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

 

Ответить

RAN

 Дата: Среда, 30.10.2013, 01:00 |
Сообщение № 17

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

Быть или не быть, вот в чем загвоздка!

 

Ответить

Alex_ST

 Дата: Среда, 30.10.2013, 09:27 |
Сообщение № 18

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

А если не выделять ничего? Просто курсор поставить «посреди» числа?
Я больше ориентировался на то, чтобы не заставлять пользователя выделять число

Андрей, как раз этот вариант скорее всего не прокатит, т.к. бухгалтеры чаще всего цифры разделяют пробелами на триады.
Тогда в Вашем варианте при курсоре, стоящем между двоек в числе, например, 111 222 333, в пропись будет преобразовано только 222.
Так что как раз пользователь и должен напрячь чуть-чуть извилины и выделить именно всё то, что он хочет преобразовать.
В моём крайнем примере регулярка как раз это и делает — из выделенного фрагмента удаляет все символы кроме цифр.

Ну а по поводу

Например, сумма записана (как это любят бухи) «123456=00» — тогда что?

так такое же на практике не может понадобиться никогда (ну не придёт же в голову никому переводить в пропись формулы).


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

 

Ответить

AndreTM

 Дата: Среда, 30.10.2013, 15:48 |
Сообщение № 19

Группа: Друзья

Ранг: Старожил

Сообщений: 1762


Репутация:
498
±

Замечаний:
0% ±


2003 & 2010

в Вашем варианте при курсоре, стоящем между двоек в числе, например, 111 222 333

Пробовал? Что получилось? (Вернее, что не получилось? И что при этом за число оказалось в коде поля?) yes

не придёт же в голову никому переводить в пропись формулы

hands То есть? Вот передо мною лежит договор аренды:

Цитата

… всего в сумме 12489=00 (Двенадцать тысяч четыреста восемьдесят девять рублей 00 копеек) ежемесячно, включая НДС…

Это формула? Этого не существует, ибо такой текст невозможен?

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Сообщение отредактировал AndreTM — Среда, 30.10.2013, 15:58
 

Ответить

Alex_ST

 Дата: Среда, 30.10.2013, 19:22 |
Сообщение № 20

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:
604
±

Замечаний:
0% ±


2003

Пробовал? Что получилось?

Не пробовал, т.к. выяснилось, что 999 999 всё равно мало.
А должно было получиться? Ну ты бы хоть полный текст процедуры выложил тогда, а не фрагмент чтобы его можно было просто не заморачиваясь началом и концом процедуры проверить. ??? Это что, у вас в бюстгалтерии так принято: вместо запятой в качестве разделителя рублей и копеек = использовать?
Уж сколько разных договоров из разных мест видел, а такого — нет!


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

Сообщение отредактировал Alex_ST — Среда, 30.10.2013, 19:23
 

Ответить
Источник
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

Function РубПропись(Сумма As Double, Optional Без_копеек As Boolean = False, _
 Optional КопПрописью As Boolean = False, Optional начинитьПрописной As Boolean = True) As String
'Функция для написания суммы прописью
 Dim ed, des, sot, ten, razr, dec
 Dim i As Integer, str As String, s As String
 Dim intPart As String, frPart As String
 Dim mlnEnd, tscEnd, razrEnd, rub, cop
 dec = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 ten = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
 des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
 sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
 razr = Array("", "тысяч", "миллион", "миллиард")
 mlnEnd = Array("ов ", " ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ")
 tscEnd = Array(" ", "а ", "и ", "и ", "и ", " ", " ", " ", " ", " ")
 razrEnd = Array(mlnEnd, mlnEnd, tscEnd, "")
 rub = Array("рублей", "рубль", "рубля", "рубля", "рубля", "рублей", "рублей", "рублей", "рублей", "рублей")
 cop = Array("копеек", "копейка", "копейки", "копейки", "копейки", "копеек", "копеек", "копеек", "копеек", "копеек")
 If Сумма >= 1000000000000# Or Сумма < 0 Then РубПропись = CVErr(xlErrValue): Exit Function
 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
 If Round(Сумма, 2) >= 1 Then
 intPart = Left$(Format(Сумма, "000000000000.00"), 12)
 For i = 0 To 3
 s = Mid$(intPart, i * 3 + 1, 3)
 If s <> "000" Then
 str = str & sot(CInt(Left$(s, 1)))
 If Mid$(s, 2, 1) = "1" Then
 str = str & ten(CInt(Right$(s, 1)))
 Else
 str = str & des(CInt(Mid$(s, 2, 1))) & IIf(i = 2, dec(CInt(Right$(s, 1))), ed(CInt(Right$(s, 1))))
 End If
 On Error Resume Next
 str = str & IIf(Mid$(s, 2, 1) = "1", razr(3 - i) & razrEnd(i)(0), _
 razr(3 - i) & razrEnd(i)(CInt(Right$(s, 1))))
 On Error GoTo 0
 End If
 Next i
 str = str & IIf(Mid$(s, 2, 1) = "1", rub(0), rub(CInt(Right$(s, 1))))
 End If
 РубПропись = str
 ''''''''''''''''''
 If Без_копеек = False Then
 frPart = Right$(Format(Сумма, "0.00"), 2)
 If frPart = "00" Then
 frPart = ""
 Else
 If КопПрописью Then
 frPart = IIf(Left$(frPart, 1) = "1", ten(CInt(Right$(frPart, 1))) & cop(0), _
 des(CInt(Left$(frPart, 1))) & dec(CInt(Right$(frPart, 1))) & cop(CInt(Right$(frPart, 1))))
 Else
 frPart = IIf(Left$(frPart, 1) = "1", frPart & " " & cop(0), frPart & " " & cop(CInt(Right$(frPart, 1))))
 End If
 End If
 РубПропись = str & " " & frPart
 End If
 ''''''''''''''''''
' РубПропись = str & frPart
 If начинитьПрописной Then Mid$(РубПропись, 1, 1) = UCase(Mid$(РубПропись, 1, 1))
' If начинитьПрописной Then РубПропись = UCase(Left(РубПропись, 1)) & Mid(РубПропись, 2)
End Function
Источник
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
Источник

Автор Irina18, 28 августа 2017, 08:55

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

[вложение удалено администратором]


Администратор

  • Administrator
  • Сообщения: 2,252
  • Записан

Не решение вашей задачи, просто совет. Включите в VBA режим, когда VBA требует создание переменных: https://forumvba.ru/index.php?topic=402.0


Администратор

  • Administrator
  • Сообщения: 2,252
  • Записан

Решение в файле. Макрос запускается после выхода из поля.

[вложение удалено администратором]

Ну этот форум просто супер. Ответы мгновенные.
Но есть маленькая просьба. Надо в код добавить чтобы сумма прописью отображалась в скобках (Один рубль 10 копеек). после скобок точка.


Администратор

  • Administrator
  • Сообщения: 2,252
  • Записан

Решение в файле.

[вложение удалено администратором]

Все отлично. Огромное спасибо. Всего Вам наилучшего добрый человек.

Возник у меня еще вопрос. Попробовала сделать новый файл. Вставила туда код из вашего файла. Но в моем новом файле ничего не работает. Может я что-то не подключаю?

[вложение удалено администратором]


Администратор

  • Administrator
  • Сообщения: 2,252
  • Записан

Макрос не запускается. Макрос запускается событием из модуля «ThisDocument».

  • Форум по VBA, Excel и Word
  • ►
    Word
  • ►
    Макросы в Word
  • ►
    Word VBA Макрос: Сумма прописью.

Источник
Function MSumProp$(chislo#) 'Автор MCH (Михаил Ч.), май 2012
Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
If chislo >= 1E+15 Or chislo < 0 Then Exit Function
 
sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
nadc = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "", "одна ", "две ")
razr = Array("триллион ", "триллиона ", "триллионов ", "миллиард ", "миллиарда ", "миллиардов ", "миллион ", "миллиона ", "миллионов ", "тысяча ", "тысячи ", "тысяч ", "рубль ", "рубля ", "рублей ")
 
rub = Left(Format(chislo, "000000000000000.00"), 15)
kop = Right(Format(chislo, "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
MSumProp = 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

Источник

На чтение 5 мин Просмотров 1.5к. Опубликовано 10.03.2021

Содержание

  1. Описание работы в Word
  2. Пример использования
  3. Установка

Описание работы в Word

Данный макрос встраивается в Word после чего Вы с легкостью и без ошибок укажите сумму прописью в любом падеже русского языка. Программа пользуется популярностью у бухгалтеров и экономистов.

После установки шаблона Word, у вас появится дополнительная вкладка меню «VBA-Excel» на которой будет располагаться команда запуска функции (см. рисунок ниже).

Пример использования

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

В диалоговом окне необходимо указать следующие параметры:

Значение — собственно число (не обязательно в числовом формате), которое необходимо написать прописью.

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

Тип данных — для добавления после суммы прописью в нужном падеже тип данных

  1. Ничего (по умолчанию если параметр не указан)
  2. Рубли
  3. Доллары США
  4. Евро
  5. Календарные дни
  6. Рабочие дни
  7. Дни
  8. Штуки

Формат вывода — формат, в котором вы хотите выводить результат

  1. 123 (Сто двадцать три) (по умолчанию если параметр не указан)
  2. 123,56 (Сто двадцать три) рубля 56 коп.
  3. 123,56 (Сто двадцать три) рубля 56 копеек
  4. (Сто двадцать три)
  5. Сто двадцать три

Если необходим другой формат вывода, укажите это в заявке — добавим.

Установка

Для того, чтобы программа работала, необходимо установить надстройку. Как это делается читайте тут «Установка надстройки»

Наш сегодняшний материал посвящается всем сотрудникам плановых и договорных отделов :)

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

И было бы замечательно , если бы она автоматически считала НДС и вписывала это значение тоже прописью.

На данный момент самый простой способ, это открыть любой онлайн сервис (типа сумма-прописью или наш ресурс выделение НДС) вписать туда сумму, скопировать оттуда результат и вставить его Word.

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

Мы будем использовать уже написанный скрипт Дата (день, месяц, год) прописью, который модернизирован для вывода денежных единиц, а также использовать материал, который позволял нам обмениваться данными из Active Directory и Excel Карточка сотрудника Active Directory через Excel

Итак что же нам необходимо сделать?

1. Открываем Word. Идем во вкладку Вид- Макросы

Даже если у нас нет ни одного макроса нажимаем кнопку — Изменить

Открывается редактор VBA

Присоединяем библиотеку jsonlib у вас после всех движений в левой верхней части должно быть подобие вот этой картинки

Что означает подчеркнутое слово Normal? Это говорит нам о том что и класс и макрос записаны в стандартном шаблоне Word Normal.dot(m). То есть при открытии любого файла а также содания нового на этом рабочем месте этот класс и макрос будут загружены автоматически.

Теперь нам надо присвоить какое нибудь сочетание клавиш что бы этот макрос запустить.

Для этого в Word. (показано действие для 2010 офиса)

Файл-Параметры-Настройка ленты -(внизу) Сочетания клавиш- Настройка

Выбираем категорию макросы. В правом поле выбираем наш макрос,

Новое сочетание клавиш — F9. Назначить

Почему F9? Вы сами можете переназанчить горячую клавишу по вызову макроса.

Все , у нас готовый шаблон которым мы можем пользоватся

Пишем Сумма договора составляет 23456.94

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

результат будет такой

Сумма договора составляет 23456.94 руб. (двадцать три тысячи четыреста пятьдесят шесть рублей девяносто четыре копейки ) в том числе НДС(18%) 3578.18 руб. (три тысячи пятьсот семьдесят восемь рублей восемнадцать копеек )

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

А как считать если у нас НДС не 18% а 10%?

Исправьте только две строки

nds = Val(body) * 18 / 118

замените на nds = Val(body) * 10 / 110

Selection.TypeText Text:=» руб. (» + ff + «) в том числе НДС(18%) » + Format(nds, «###0.00″) + » руб. (» + ff1 + «)»

на Selection.TypeText Text:=» руб. (» + ff + «) в том числе НДС(10%) » + Format(nds, «###0.00″) + » руб. (» + ff1 + «)»

Как можете заметить Selection.TypeText Text — отвечает за вывод текста и что вы уж там напишите, ограничена лишь вашей фантазией.

Если у вас есть какие то вопросы замечания или нужна помощь , то обращатесь.

Раньше при оформлении договоров в word напрягало каждый раз дублировать суммы всех платежей прописью, особенно когда суммы длинные, а платежей много.

Удивился, что это умеет делать автоматом обычная бесплатная программа punto switcher (которая от яндекса) для переключения раскладки клавиатуры. Пользуюсь ей лет 15, но про эту фишку не знал.

Выделяешь цифры, например 12436, жмешь сочетание клавишь и цифры превращается в «двенадцать тысяч четыреста тридцать шесть».

Забавно, но по умолчанию эта функция отключена! Чтобы включить, нужно зайти в настройки, выбрать слева «горячие клавиши» и в перечне напротив строчки «Преобразовать числа в текст» поставить удобное сочетание клавиш.

Зачем было ее так прятать — непонятно.
Тем не менее здорово облегчает жизнь, особенно если суммы часто корректируются и приходится вносить изменения в один и тот же договор много раз.
Если в числе есть запятая, то после целой части добавляется «руб», дробная остается цифрами и после нее добавляется «коп».

  • Распечатать

Оцените статью:

  1. 5
  2. 4
  3. 3
  4. 2
  5. 1

(0 голосов, среднее: 0 из 5)

Поделитесь с друзьями!

Источник

Наш сегодняшний материал посвящается всем сотрудникам плановых  и договорных отделов :)

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

И было бы замечательно , если бы она автоматически считала НДС и вписывала это значение тоже прописью.

На данный момент самый простой способ, это открыть любой онлайн сервис (типа сумма-прописью или наш ресурс выделение НДС) вписать туда сумму, скопировать оттуда результат и вставить его Word.

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

Мы будем использовать уже написанный скрипт Дата (день, месяц, год) прописью, который модернизирован для вывода денежных единиц, а также использовать материал, который позволял нам обмениваться данными из Active Directory и Excel Карточка сотрудника Active Directory через Excel

Итак что же нам необходимо сделать?

1. Открываем Word. Идем во вкладку Вид- Макросы

Даже если у нас нет ни одного макроса  нажимаем кнопку — Изменить

Открывается редактор VBA

создаем макрос

Sub Макрос1()

    Selection.MoveStartUntil Cset:=» «, Count:=wdBackward

    Selection.MoveEndUntil Cset:=» «, Count:=wdForward

    body = Selection

Set oHttp = CreateObject(«MSXML2.ServerXMLHTTP»)

sURL = «http://jabber.pozitiv-r.ru/scripts/reqexcel.php»

oHttp.Open «POST», sURL, False

oHttp.setrequestheader «User-Agent», «Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)»

oHttp.setrequestheader «Content-Type», «application/x-www-form-urlencoded»

oHttp.send («from=www&key=towo&body=» + Format(body, «###0.00») + «!3»)

Result = oHttp.ResponseText

Dim jsonlib                         As New jsonlib ‘class name you give it

Set oContracts = jsonlib.parse(CStr(Result))

ff = oContracts(«result»)

oHttp.Open «POST», sURL, False

oHttp.setrequestheader «User-Agent», «Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)»

oHttp.setrequestheader «Content-Type», «application/x-www-form-urlencoded»

nds = Val(body) * 18 / 118

oHttp.send («from=www&key=towo&body=» + (Format(nds, «###0.00»)) + «!3»)

Result = oHttp.ResponseText

Set oContracts = jsonlib.parse(CStr(Result))

ff1 = oContracts(«result»)

Selection.Collapse Direction:=wdCollapseEnd

Selection.TypeText Text:=» руб. (» + ff + «) в том числе НДС(18%)  » + Format(nds, «###0.00″) + » руб. (» + ff1 + «)»

End Sub

Присоединяем библиотеку jsonlib у вас после всех движений в левой верхней части должно быть подобие вот этой картинки

Что означает подчеркнутое слово Normal? Это говорит нам о том что и класс и макрос записаны в стандартном шаблоне Word Normal.dot(m). То есть при открытии любого файла а также содания нового на этом рабочем месте этот класс и макрос будут загружены автоматически.

Теперь нам надо присвоить какое нибудь сочетание клавиш что бы этот макрос запустить.

Для этого в Word. (показано действие для 2010 офиса)

Файл-Параметры-Настройка ленты -(внизу) Сочетания клавиш- Настройка 

Выбираем категорию макросы. В правом поле выбираем наш макрос,

Новое сочетание клавиш — F9. Назначить

Почему F9? Вы сами можете переназанчить горячую клавишу по вызову макроса.

Все , у нас готовый шаблон которым мы можем пользоватся

Пишем Сумма договора составляет 23456.94 

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

результат будет такой

Сумма договора составляет 23456.94 руб. (двадцать три тысячи четыреста пятьдесят шесть рублей девяносто четыре копейки ) в том числе НДС(18%)  3578.18 руб. (три тысячи пятьсот семьдесят восемь рублей восемнадцать копеек )

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

А как считать если у нас НДС не 18% а 10%?

Исправьте только две строки 

nds = Val(body) * 18 / 118

замените на nds = Val(body) * 10 / 110

и

Selection.TypeText Text:=» руб. (» + ff + «) в том числе НДС(18%)  » + Format(nds, «###0.00″) + » руб. (» + ff1 + «)»

на Selection.TypeText Text:=» руб. (» + ff + «) в том числе НДС(10%)  » + Format(nds, «###0.00″) + » руб. (» + ff1 + «)»

Как можете заметить Selection.TypeText Text — отвечает за вывод текста и что вы уж там напишите, ограничена лишь вашей фантазией.

Если у вас есть какие то вопросы замечания или нужна помощь , то обращатесь.

Удачных расчетов!

Источник

Код пользовательской функции VBA Excel для преобразования денежного значения из числовой формы в сумму прописью. До 12 целочисленных разрядов включительно.

С помощью данной функции денежные значения преобразуются в текст следующего формата: 0,00 = Ноль рублей 00 копеек.

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

Public Function СуммаПрописью(x As Double) As String

If x > 999999999999.99 Then

СуммаПрописью = «Аргумент больше 999 999 999 999.99!»

ElseIf x < 0 Then

СуммаПрописью = «Аргумент отрицательный!»

Else

x = FormatNumber(x, 2)

Dim b As Byte, b1 As Byte, b2 As Byte, kop As String

b = (x — Fix(x)) * 100

b2 = b 10

b1 = b Mod 10

If b2 <> 1 And b1 = 1 Then

kop = » копейка»

ElseIf b2 <> 1 And b1 > 1 And b1 < 5 Then

kop = » копейки»

Else

kop = » копеек»

End If

kop = b2 & b1 & kop

Dim y(1 To 4) As Integer, i1 As Byte

For i1 = 1 To 4

x = Fix(x) / 1000

y(i1) = (x — Fix(x)) * 1000

Next

Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _

y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _

Text4 As String

For i2 = 1 To 4

y1 = y(i2) Mod 10

y2 = (y(i2) — y1) / 10 Mod 10

y3 = y(i2) 100

Text1 = Choose(y3 + 1, «», «сто «, «двести «, «триста «, «четыреста «, _

«пятьсот «, «шестьсот «, «семьсот «, «восемьсот «, «девятьсот «)

Text2 = Choose(y2 + 1, «», «», «двадцать «, «тридцать «, «сорок «, _

«пятьдесят «, «шестьдесят «, «семьдесят «, «восемьдесят «, «девяносто «)

If y2 = 1 Then

Text3 = Choose(y1 + 1, «десять «, «одиннадцать «, «двенадцать «, _

«тринадцать «, «четырнадцать «, «пятнадцать «, «шестнадцать «, _

«семнадцать «, «восемнадцать «, «девятнадцать «)

ElseIf y2 <> 1 And i2 = 2 Then

Text3 = Choose(y1 + 1, «», «одна «, «две «, «три «, «четыре «, «пять «, _

«шесть «, «семь «, «восемь «, «девять «)

Else

Text3 = Choose(y1 + 1, «», «один «, «два «, «три «, «четыре «, «пять «, _

«шесть «, «семь «, «восемь «, «девять «)

End If

If y2 <> 1 And y1 = 1 Then

Text4 = Choose(i2, «рубль «, «тысяча «, «миллион «, «миллиард «)

ElseIf y2 <> 1 And y1 > 1 And y1 < 5 Then

Text4 = Choose(i2, «рубля «, «тысячи «, «миллиона «, «миллиарда «)

ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then

Text4 = Choose(i2, «рублей «, «», «», «»)

Else

Text4 = Choose(i2, «рублей «, «тысяч «, «миллионов «, «миллиардов «)

End If

Text(i2) = Text1 & Text2 & Text3 & Text4

Next

If y(1) + y(2) + y(3) + y(4) = 0 Then

Text0 = «ноль рублей « & kop

Else

Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop

End If

СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)

End If

End Function

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

Источник

Сумма прописью 103

2.Если одновременно открыто несколько приложений Office или, по крайней мере, несколько рабочих книг Excel, то необходимо выделить имя требуемой книги в окне VBA-проекта (см. рис. ниже). Если открыта только одна рабочая книга, то ничего выделять не требуется.

3.В строке меню редактора Visual Basic выберите команду Insert | Module (Вставка | Модуль).

Врезультате в состав рабочей книги будет включен программный модуль Module1 (“Модуль1”, см. рисунок), а в центре экрана появится окно программного кода вновь созданного модуля, пока что пустое.

Функции

Второе новое понятие, с которым нам необходимо познакомиться, — это процедура-функция.

ПРИМЕЧАНИЕ

Справка MS Office трактует и Sub, и Function, как понятия процедуры, но двух разных типов.

Все макросы VBA, которые до сих пор были рассмотрены, относились к типу процедурыподпрограммы (Sub). Но существуют также процедуры типа Function: такие процедуры возвращают значение подобно встроенным функциям Visual Basic. Например, использованная ранее функция Str() возвращает строковое значение взамен переданного ей в параметре числа.

Постановка задачи

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

Итак, перед нами пустое окно кода только что созданного программного модуля, в котором предстоит создать процедуру-функцию.

Как добавить в модуль процедуру-функцию

1.Выберите в строке меню редактора Visual Basic команду

Insert | Procedure (Вставка | Процедура). В результате откроется диалоговое окно Add Procedure (Вставка процедуры).

2.Установите переключатель Type (Тип) в положение

Function.

3.Установите переключатель Scope (Область определения) в положение Public (Общая).

4.Введите в поле Name (Имя) имя функции (в данном случае это должна быть строка “Сумма_прописью”).

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

Полученную “заготовку” процедуры необходимо отредактировать в соответствии с возлагаемыми на нее задачами. В автоматически созданной заготовке, конечно, не указан тип возвращаемого значения и параметр.

Параметр N представляет значение, передаваемое в функцию извне, это значение должно относиться к “денежному” числовому типу Currency. Сама же функция должна иметь тип String, поскольку возвращает строковое значение. В результате окно кода модуля должно приобрести вид, как на рис. 4.1.

104 Глава 4. Практикум программирования на VBA для Excel и Word

Рис. 4.1. Окно кода программного модуля — автоматически созданная процедура откорректирована вручную

см. также в приложении раздел “Currency”.

Разрабатываем исходный текст функции Сумма_прописью()

Остается создать собственно сам программный код функции. Код такого назначения много раз реализовывался на различных языках программирования, при этом использовались различные алгоритмы, использующие в каждом случае особенности конкретного языка. Не будем “мудрствовать лукаво”, во-первых, потому, что возможности Visual Basic сравнительно невелики, и, вовторых, чтобы не усложнять программный код в синтаксическом отношении. В результате исходный текст функции получится несколько громоздким (в принципе, даже на VBA его можно было бы сделать более компактным), но при этом достаточно компактным для понимания.

Итак, представим, что какой-то макрос обратился к функции Сумма_прописью, и начинается ее выполнение. Переменная N в этот момент содержит числовое “денежное” значение, переданное в функцию извне. Чтобы как-то работать с ним, нам необходимо преобразовать его в строку символов. Объявим для этого строковую переменную S, а вместе с ней — переменную SUM, в которой затем будем “строить” результирующую строку суммы прописью:

Dim S, SUM As String

Использование функции FORMAT () для преобразования числа в строку

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

S = Format(N, «000000.00»)

В результате выполнения этого оператора функция Format вернет в переменную S строковое значение, представляющее собой денежную сумму цифрами в заданном формате. То есть, для N = 123456.78 вернется строка “123456.78”, а для N = 123 вернется “000123.00”.

см. также в приложении раздел “Функция Format”.

Теперь можно просматривать последовательно первые шесть символов строки S, и, в соответствии с содержащимися в этих позициях цифрами, создавать строку суммы прописью.

ПРИМЕЧАНИЕ

В данном примере задача решается для шестизначных сумм, то есть сумм, состоящих из не более, чем шести знаков перед запятой. Можно без труда распространить такое решение на большее число знаков. Здесь задача ограничивается сознательно, поскольку избранный способ решения делает код (в случае большого числа знаков) слишком громоздким. Это не составляет проблемы в окне редактора Visual Basic, поскольку код процедуры состоит из повторяющихся похожих структур, которые можно быстро создать при помощи операций копирования и вставки. Однако, заниматься подобными построениями на книжной странице вряд ли целесообразно.

Сумма прописью 105

Анализ текстовой строки

Проанализируем вначале первый символ строки. Для этого воспользуемся строковой функцией Mid. Эта функция возвращает заданное число символов (третий параметр) из заданной позиции (второй параметр) в заданной строке (первый параметр). Например, если переменная S содержит строку “123456.78”, то выражение

Mid(S, 3, 1)

вернет символ “3” (если бы третий параметр был равен, скажем, 5, то вернулась бы строка

“345.7”).

см. также в приложении раздел “Выделение подстроки”.

Итак, можно получить первый символ строки S при помощи выражения Mid(S, 1, 1). Проанализируем этот символ, представляющий шестой знак суммы, то есть сотни тысяч:

Select Case Mid(S, 1, 1)

Case «0»:

Case «1»: SUM = SUM + «сто «

Case «2»: SUM = SUM + «двести «

Case «3»: SUM = SUM + «триста «

Case «4»: SUM = SUM + «четыреста «

Case «5»: SUM = SUM + «пятьсот «

Case «6»: SUM = SUM + «шестьсот «

Case «7»: SUM = SUM + «семьсот «

Case «8»: SUM = SUM + «восемьсот «

Case «9»: SUM = SUM + «девятьсот «

End Select

Если в числе нет соответствующего разряда, то в этой позиции окажется символ “0” и со строкой SUM ничего не произойдет. В противном случае в нее будет помещено одно из слов, обозначающих сотни тысяч.

Задача была бы совсем тривиальной, если бы могли действовать далее аналогичным образом, разбирая строку разряд за разрядом и просто подставляя необходимые слова. Увы, русские имена числительные не столь единообразны. Для чисел от 11 до 20 действуют совершенно иные правила, чем, скажем, для чисел от 21 до 30, и поэтому разряды, относящиеся к десяткам и единицам тысяч, придется анализировать “в комплексе” друг с другом. Надо предусмотреть три принципиально разных варианта. Для чисел от 10 до 19 необходимо использовать отдельную конструкцию, которая “покрывала” бы сразу два разряда — десятки и единицы. Чтобы выделить этот случай, необходимо сравнить второй разряд с единицей:

If Mid(S, 2, 1) = «1» Then

…

End If

При этом, если второй разряд действительно оказался равным единице, анализировать далее следует третий разряд:

Select Case Mid(S, 3, 1)

Case «0»: SUM = SUM + «десять » Case «1»: SUM = SUM + «одиннадцать «

…

Case «9»: SUM = SUM + «девятнадцать » End Select

106 Глава 4. Практикум программирования на VBA для Excel и Word

Для всех остальных случаев второй и третий разряды необходимо формировать в строке суммы раздельно, например, “двадцать” + “одна” (не забываем, речь идет о тысячах и поэтому “од- на”). Следующая конструкция отфильтрует все десятки и единицы кроме диапазона 10…19:

If Mid(S, 2, 1) > «1» _ Or _

Mid(S, 2, 1) = «0» Then

…

End If

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

Select Case Mid(S, 2, 1)

Case «2»: SUM = SUM + «двадцать «

…

Case «9»: SUM = SUM + «девяносто » End Select

А затем:

Select Case Mid(S, 3, 1)

Case «1»: SUM = SUM + «одна «

…

Case «9»: SUM = SUM + «девять » End Select

Далее, перед переходом от тысяч к “простым” сотням, десяткам и единицам, нас подстерегает маленькая проблема. Нельзя просто добавить к строке SUM слово “тысяч” и двигаться дальше. Возможны случаи как “тысяч” (например, 11, 100, 155), так и “тысяча” (например, 1, 21, 101 ) и даже “тысячи” (например, 2, 34, 503). Все эти варианты необходимо правильно распознать и добавить к строке SUM верное слово. Начнем с того, что тысяч в числе суммы вообще может не быть и в этом случае соответствующее слово добавлять нельзя:

If SUM <> «» Then

…

If

Затем, разделим варианты на “от 10 до 19” и “все остальное”:

If Mid(S, 2, 1) = «1» Then SUM = SUM + «тысяч «

Else

…

End If

Для “всего остального” будем различать три случая — одна тысяча, две/три/четыре тысячи и опять же “все остальное”:

Select Case Mid(S, 3, 1)

Case «1»: SUM = SUM + «тысяча «

Case «2», «3», «4»: SUM = SUM + «тысячи «

Case Else: SUM = SUM + «тысяч «

End Select

Сумма прописью 107

Строка Case Else выполняется в случае, когда ни одна из строк Case не выполнена. В результате получим весьма разветвленную конструкцию:

If SUM <> «» Then

If Mid(S, 2, 1) = «1» Then SUM = SUM + «тысяч «

Else

Select Case Mid(S, 3, 1)

Case «1»: SUM = SUM + «тысяча «

Case «2», «3», «4»: SUM = SUM + «тысячи » Case Else: SUM = SUM + «тысяч «

End Select

End If

End If

см. также в приложении раздел “Конструкция Select Case … End Select”.

Следующую тройку разрядов − 4-й, 5-й и 6-й, то есть сотни, десятки и единицы, можно обработать почти точно таким же способом. Единственная особенность, из-за которой их приходится обрабатывать отдельно, заключается в разном роде слов “тысяча” и “рубль”. Придется использовать “один” вместо “одна” и “два” вместо “две”.

К полученной в результате строке SUM необходимо еще добавить окончание “руб.” и число копеек:

SUM = SUM + » руб. » + Mid(S, 8, 2) + » коп.»

Функция Mid извлекает два последних символа из строки S, в предположении, что это должны быть цифры, соответствующие числу копеек в сумме (по бухгалтерским правилам, в сумме прописью число копеек пишется цифрами). О том, чтобы это действительно было число копеек, “позаботились” функция Format и денежный числовой тип Currency.

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

Сумма_прописью = UCase(Left(SUM, 1)) + Right(SUM, Len(SUM) — 1)

Функция UCase уже была рассмотрена (см. в гл. 3 раздел “Анализ значений слов в документе Word”) — она преобразует произвольную строку в строку с только прописными буквами.

см. также в приложении раздел “Преобразования регистра (функции LCase, UCase)”.

Функции Left и Right возвращают заданное число символов из строки-параметра, соответственно, слева и справа.

см. также в приложении раздел “Выделение подстроки”.

Функция Len возвращает число, равное длине строки-параметра.

см. также в приложении раздел “Форматирование строки”.

Таким образом, оператор соберет строковое значение из первого символа, преобразованного в верхний регистр и всех остальных символов кроме первого, никак не преобразованных.

В итоге можно записать исходный текст функции Сумма_прописью (листинг 4.1).

ЛИСТИНГ 4.1

Public Function Сумма_прописью(N As Currency) As String

Dim S, SUM As String

S = Format(N, «000000.00»)

108 Глава 4. Практикум программирования на VBA для Excel и Word

SUM = «»

Select Case Mid(S, 1, 1)

Case «0»:

Case «1»: SUM = SUM + «сто «

Case «2»: SUM = SUM + «двести «

Case «3»: SUM = SUM + «триста «

Case «4»: SUM = SUM + «четыреста «

Case «5»: SUM = SUM + «пятьсот «

Case «6»: SUM = SUM + «шестьсот «

Case «7»: SUM = SUM + «семьсот «

Case «8»: SUM = SUM + «восемьсот «

Case «9»: SUM = SUM + «девятьсот «

End Select

If Mid(S, 2, 1) > «1» _

Or _

Mid(S, 2, 1) = «0» Then

Select Case Mid(S, 2, 1)

Case «2»: SUM = SUM + «двадцать «

Case «3»: SUM = SUM + «тридцать «

Case «4»: SUM = SUM + «сорок «

Case «5»: SUM = SUM + «пятьдесят «

Case «6»: SUM = SUM + «шестьдесят «

Case «7»: SUM = SUM + «семьдесят «

Case «8»: SUM = SUM + «восемьдесят «

Case «9»: SUM = SUM + «девяносто «

End Select

Select Case Mid(S, 3, 1)

Case «1»: SUM = SUM + «одна «

Case «2»: SUM = SUM + «две «

Case «3»: SUM = SUM + «три » Case «4»: SUM = SUM + «четыре » Case «5»: SUM = SUM + «пять » Case «6»: SUM = SUM + «шесть » Case «7»: SUM = SUM + «семь » Case «8»: SUM = SUM + «восемь » Case «9»: SUM = SUM + «девять «

End Select

End If

If Mid(S, 2, 1) = «1» Then

Select Case Mid(S, 3, 1)

Case «0»: SUM = SUM + «десять » Case «1»: SUM = SUM + «одиннадцать » Case «2»: SUM = SUM + «двенадцать » Case «3»: SUM = SUM + «тринадцать «

Case «4»: SUM = SUM + «четырнадцать «

Case «5»: SUM = SUM + «пятнадцать «

Case «6»: SUM = SUM + «шестнадцать «

Case «7»: SUM = SUM + «семнадцать «

Сумма прописью 109

Case «8»: SUM = SUM + «восемнадцать «

Case «9»: SUM = SUM + «девятнадцать «

End Select

End If

If SUM <> «» Then

If Mid(S, 2, 1) = «1» Then SUM = SUM + «тысяч «

Else

Select Case Mid(S, 3, 1)

Case «1»: SUM = SUM + «тысяча «

Case «2», «3», «4»: SUM = SUM + «тысячи » Case Else: SUM = SUM + «тысяч «

End Select

End If

End If

Select Case Mid(S, 4, 1)

Case «0»:

Case «1»: SUM = SUM + «сто «

Case «2»: SUM = SUM + «двести «

Case «3»: SUM = SUM + «триста «

Case «4»: SUM = SUM + «четыреста «

Case «5»: SUM = SUM + «пятьсот «

Case «6»: SUM = SUM + «шестьсот «

Case «7»: SUM = SUM + «семьсот «

Case «8»: SUM = SUM + «восемьсот «

Case «9»: SUM = SUM + «девятьсот «

End Select

If Mid(S, 5, 1) > «1» _

Or _

Mid(S, 5, 1) = «0» Then

Select Case Mid(S, 5, 1)

Case «2»: SUM = SUM + «двадцать «

Case «3»: SUM = SUM + «тридцать «

Case «4»: SUM = SUM + «сорок «

Case «5»: SUM = SUM + «пятьдесят «

Case «6»: SUM = SUM + «шестьдесят «

Case «7»: SUM = SUM + «семьдесят «

Case «8»: SUM = SUM + «восемьдесят «

Case «9»: SUM = SUM + «девяносто «

End Select

Select Case Mid(S, 6, 1)

Case «1»: SUM = SUM + «один «

Case «2»: SUM = SUM + «два «

Case «3»: SUM = SUM + «три «

Case «4»: SUM = SUM + «четыре «

Case «5»: SUM = SUM + «пять «

Case «6»: SUM = SUM + «шесть «

Case «7»: SUM = SUM + «семь «

Case «8»: SUM = SUM + «восемь «

110 Глава 4. Практикум программирования на VBA для Excel и Word

Case «9»: SUM = SUM + «девять «

End Select

End If

If Mid(S, 5, 1) = «1» Then

Select Case Mid(S, 6, 1)

Case «0»: SUM = SUM + «десять «

Case «1»: SUM = SUM + «одиннадцать «

Case «2»: SUM = SUM + «двенадцать «

Case «3»: SUM = SUM + «тринадцать «

Case «4»: SUM = SUM + «четырнадцать «

Case «5»: SUM = SUM + «пятнадцать «

Case «6»: SUM = SUM + «шестнадцать «

Case «7»: SUM = SUM + «семнадцать «

Case «8»: SUM = SUM + «восемнадцать «

Case «9»: SUM = SUM + «девятнадцать «

End Select

End If

SUM = SUM + » руб. » + Mid(S, 8, 2) + » коп.»

Сумма_прописью = UCase(Left(SUM, 1)) + Right(SUM, Len(SUM) — 1)

End Function

Функция готова! Готова к чему? Можно использовать ее теперь в любом макросе, где она потребуется.

Использование функции Сумма_прописью()

Предположим, требуется автоматически формировать столбец “сумма прописью” по значениям столбца “сумма”, в который эти числовые значения либо вводятся пользователем, либо отображаются в него посредством связей Automation. Чтобы решить эту задачу, будем обрабатывать событие Change. При любом изменении значения в одной из ячеек листа будет сгенерировано это событие. Ссылка на ячейку при этом передается в процедуру обработки события посредством параметра Target.

Создание процедуры-обработчика события Change для листа рабочей книги Excel

Читатель уже без труда создаст процедуру-обработчик события Change для того листа рабочей книги, где такой обработчик требуется. Вот, какой исходный текст следует поместить в эту процедуру (листинг 4.2).

ЛИСТИНГ 4.2

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Column = 1 Then

Target.Offset(0, 1).Value = Сумма_прописью(Target.Value)

End If

End Sub

Сумма прописью 111

Параметр Target указывает на изменившуюся ячейку. А свойство Offset(0, 1) этой ячейки указывает на ячейку справа от нее. (Нетрудно догадаться, что, скажем, выражение Offset(1, 2) указывало бы на ячейку, находящуюся одной строкой ниже и двумя столбцами правее). И вот, если речь идет о ячейке первого столбца (Column = 1), то в ячейку справа поместим значение, возвращенное функцией Сумма_прописью. Разумеется, предполагается, что столбцы, о которых идет речь, отформатированы надлежащим образом — для ввода денежных и текстовых значений соответственно. Теперь можно проверить работоспособность макроса путем ввода различных числовых значений в первый столбец. Вернемся в окно MS Excel и введем значения в первый столбец того листа, для которого был создан обработчик события Change. Результат изображен на рис. 4.2.

Рис. 4.2. Строки с суммой прописью формируются автоматически в столбце B

Защита от возникновения каскадных событий

ПРИМЕЧАНИЕ

Остается прояснить маленький вопрос — зачем в начале процедуры использована строка On

Error Resume Next, защищающая макрос от прерываний при возникновении ошибок. Какие ошибки могут тут возникнуть? И еще: зачем проверять номер столбца?

Дело в том, что событие Change возникает практически при любом изменении значения ячейки. И если просто прочитать значение некоторой ячейки и записать возвращенное функцией значение в ячейку справа, то возникнет так называемое каскадное событие. Обработка события Change для первой ячейки еще не завершилось, но уже возникает событие Change для ячейки справа (ведь в нее записано новое значение!), которое, в свою очередь, вызовет событие Change для следующей ячейки справа и так далее. Факт обработки события является в данном случае причиной возникновения такого же события (это, кстати сказать, классическая причина возникновения каскадных событий).

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

нее событие Change приведет к ошибке, поскольку функции Сумма_прописью будет передано строковое значение из второго столбца (а ожидает она, как указано, числовое денежное значение типа Currency). Благодаря этому обстоятельству, а также благодаря строке On Error Resume

112 Глава 4. Практикум программирования на VBA для Excel и Word

Next цепочка каскадного события в нашем случае оборвется в самом начале. Но общий способ “предохранения” от каскадных событий состоит в том, чтобы ограничить сферу действия процедуры достаточно узким диапазоном. Для этого и наложено условие If Target.Column = 1 Then… (если изменившаяся ячейка принадлежит столбцу 1, то).

← см. также в гл. 3 раздел “Управление ошибками выполнения макроса”.

Частотный словарь

Вряд ли эту задачу можно отнести к часто встречающимся проблемам современного офиса. И все же, автоматическое составление частотного словаря не лишено практического смысла в некоторых ситуациях, когда имеет значение именно словарный состав документа. Главная же причина, по которой задача “Частотный словарь” включена в состав данной главы, заключается в том, что для ее решения необходимо будет широко использовать разнообразные возможности языка VBA, и, в то же самое время, достаточно глубоко “заглянуть” в объектную модель документа Word. Словом, решение этой задачи — хорошая практика для человека, намеревающегося работать с документами Word посредством макросов VBA.

Постановка задачи

Итак, в чем же, собственно, заключается задача? Необходимо написать макрос, который составлял бы частотный словарь документа Word. Словарь должен состоять из заданного числа слов, наиболее часто встречающихся в документе. Например, 10 или 500 наиболее употребительных в данном документе слов. Конечно, отобранные слова необходимо упорядочить в порядке убывания их частоты — это обычный принцип построения частотных словарей. В какой форме должен быть создан словарь? Разумеется, в форме нового документа Word — работая в среде Word было бы странно избрать какой-то иной путь.

Каким образом будет запускаться будущий макрос? На этот раз самым, что ни на есть, обыкновенным способом. Это будет просто макрос с именем “Частотный_словарь”, который можно будет запустить при помощи команды Сервис | Макрос | Макросы. Вначале необходимо создать его, введя в поле Èìÿ строку “Частотный_словарь” и щелкнув на кнопке Создать. А затем, после того, как исходный текст макроса будет введен, его можно будет выполнить при помощи той же команды Сервис | Макрос | Макросы — достаточно выделить в списке имя “Частотный_словарь” и щелкнуть на кнопке Выполнить.

Разрабатываем исходный текст макроса

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

Использование массивов

Размерность буферного массива имеет большое значение. Не известно, сколько разных слов может содержаться в документе, поэтому идеальный массив для подсчета слов должен бы был являться бесконечным. Увы, это невозможно, и нам придется пойти на компромисс. Допустим, что самый большой документ, который может встретиться, состоит из 5000 слов. Тогда вполне разумным выглядит предположение, что предстоит иметь дело с не более чем 3000 разных слов. Пусть массив строк для хранения подсчитываемых слов имеет размерность 3000. Размер словаря можно задать произвольным образом — пусть он состоит из 200 наиболее часто встречающихся слов.

Объявление констант

Эти две величины имеет смысл объявить в качестве констант, тогда их нетрудно будет изменить — достаточно исправить значение в объявлении константы и соответствующая величина изменится повсюду в программе:

Соседние файлы в папке Книги

  • #

    31.05.201530.78 Кб77excel_vba.html

  • #
  • #

    31.05.2015192.38 Кб65VBA.htm

  • #
  • #
Источник

Like this post? Please share to your friends:
  • Vba word список папок
  • Vba word сохранить как pdf
  • Vba word сохранить все
  • Vba word создать папку
  • Vba word создание таблиц