Добрый день, макрос в normal.dot пишет сумму 100000,00 видом (сто тысяч) рублей 00 копеек
Помогите реализовать запись с дубрилованием суммы с разделением пробелом разрядов
Образец:
Сумма: 100000,00 Пропись: 100 000 (сто тысяч) рублей 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 |