Перейти к содержанию

Функция Сумма прописью для Excel


super

Рекомендуемые сообщения

Эта функция выводит сумму прописью с копейками

В "старом" Excel переходим в меню "Сервис –> Макрос –> Редактор Visual Basic" (или жмём Alt и F11);

В Excel 2007 или 2010 "Разработчик"

В окне Microsoft Visual Basic выбираем меню Insert –> Module;

Затем в окне Module1 (Code), вводим (копируем отсюда и вставляем) код:

 Option ExplicitFunction Сумма_Прописью(s As Currency) As StringDim dis(5) As IntegerDim num_propis(0 To 19) As StringDim num_p2(0 To 9) As StringDim num_p3(0 To 9) As StringDim ss As CurrencyDim txt As StringDim n As IntegerDim i As IntegerIf s = 0 ThenСумма_Прописью = "0 руб. 00 коп."Exit FunctionEnd Ifdis(5) = (Int(s * 100) / 100 - Int(s)) * 100ss = Int(s)dis(1) = ss - Int(ss / 1000) * 1000ss = Int(ss / 1000)dis(2) = ss - Int(ss / 1000) * 1000ss = Int(ss / 1000)dis(3) = ss - Int(ss / 1000) * 1000ss = Int(ss / 1000)dis(4) = ss - Int(ss / 1000) * 1000ss = Int(ss / 1000)num_propis(0) = ""num_propis(1) = "один "num_propis(2) = "два "num_propis(3) = "три "num_propis(4) = "четыре "num_propis(5) = "пять "num_propis(6) = "шесть "num_propis(7) = "семь "num_propis(8) = "восемь "num_propis(9) = "девять "num_propis(10) = "десять "num_propis(11) = "одиннадцать "num_propis(12) = "двенадцать "num_propis(13) = "тринадцать "num_propis(14) = "четырнадцать "num_propis(15) = "пятнадцать "num_propis(16) = "шестнадцать "num_propis(17) = "семнадцать "num_propis(18) = "восемнадцать "num_propis(19) = "девятнадцать "num_p2(0) = ""num_p2(1) = ""num_p2(2) = "двадцать "num_p2(3) = "тридцать "num_p2(4) = "сорок "num_p2(5) = "пятьдесят "num_p2(6) = "шестьдесят "num_p2(7) = "семьдесят "num_p2(8) = "восемьдесят "num_p2(9) = "девяносто "num_p3(0) = ""num_p3(1) = "сто "num_p3(2) = "двести "num_p3(3) = "триста "num_p3(4) = "четыреста "num_p3(5) = "пятьсот "num_p3(6) = "шестьсот "num_p3(7) = "семьсот "num_p3(8) = "восемьсот "num_p3(9) = "девятьсот "txt = ""If ss <> 0 Thenn = MsgBox("Сумма не соответствует формату", 16, "Сумма прописью")Сумма_Прописью = ""Exit FunctionEnd IfFor i = 4 To 1 Step -1n = 0If dis(i) > 0 Thenn = Int(dis(i) / 100)txt = txt & num_p3(n)n = Int((dis(i) - n * 100) / 10)txt = txt & num_p2(n)If n < 2 Thenn = dis(i) - (Int(dis(i) / 10) - n) * 10Elsen = dis(i) - Int(dis(i) / 10) * 10End IfSelect Case nCase 1If i = 2 Then txt = txt & "одна " Else txt = txt & "один "Case 2If i = 2 Then txt = txt & "две " Else txt = txt & "два "Case Elsetxt = txt & num_propis(n)End SelectSelect Case iCase 2If n = 0 Or n > 4 Thentxt = txt + "тысяч "ElseIf n = 1 Then txt = txt + "тысяча " Else txt = txt + "тысячи "End IfCase 3If n = 0 Or n > 4 Thentxt = txt + "миллионов "ElseIf n = 1 Then txt = txt + "миллион " Else txt = txt + "миллиона "End IfCase 4If n = 0 Or n > 4 Thentxt = txt + "миллиардов "ElseIf n = 1 Then txt = txt + "миллиард " Else txt = txt + "миллиарда "End IfEnd SelectEnd IfNext iIf n = 0 Or n > 4 Thentxt = txt + "рублей"ElseIf n = 1 Then txt = txt + "рубль" Else txt = txt + "рубля"End Iftxt = UCase$(Left$(txt, 1)) & Mid$(txt, 2)If dis(5) = 0 ThenСумма_Прописью = txt & " " & " 00 коп."ElseСумма_Прописью = txt & " " & dis(5) & " коп."End IfEnd FunctionPrivate Sub Command1_Click()Text1.Text = Сумма_Прописью(Text1.Text)End Sub
Если меню "Разработчик" нет, то ставим галочку как на картинке

post-2-0-62797000-1328637512_thumb.gif

post-2-0-95142500-1328637527_thumb.gif

Ссылка на комментарий

В архиве

Эта тема находится в архиве и закрыта для дальнейших ответов.

×
×
  • Создать...