Добрый вечер. Есть макрос:
With doc_res.Range.Find
.Text = "//TEXT//"
.Replacement.Text = row_src.Range("I1").Value
.MatchWholeWord = True
.MatchCase = True
.Replacement.Highlight = False
.Execute Replace:=2
End With
Он берет значение в колонке I EXEL и замещает им в шаблоне Word //TEXT//.
В данном случае это число.
Написана отдельная функция в модуле которая преобразует число в текст, пример - (5000, 00 преобразует в пять тысяч 00 копеек), она активируется с листа формулой =MSumProp().
Нужно сделать так чтобы к значению row_src.Range("I1").Value применялась функция MSumProp.
Функция число - текст находится в модуле выглядит так:
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
Напишите вашу цену.
With doc_res.Range.Find
.Text = "//TEXT//"
.Replacement.Text = row_src.Range("I1").Value
.MatchWholeWord = True
.MatchCase = True
.Replacement.Highlight = False
.Execute Replace:=2
End With
Он берет значение в колонке I EXEL и замещает им в шаблоне Word //TEXT//.
В данном случае это число.
Написана отдельная функция в модуле которая преобразует число в текст, пример - (5000, 00 преобразует в пять тысяч 00 копеек), она активируется с листа формулой =MSumProp().
Нужно сделать так чтобы к значению row_src.Range("I1").Value применялась функция MSumProp.
Функция число - текст находится в модуле выглядит так:
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
Напишите вашу цену.
Изменено: - 08.09.2022 21:57:10