Код пользовательской функции 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, можно использовать блок ячеек с формулами для возврата суммы прописью. Например, в бланках различных документов, которые отдельными файлами передаются на компьютеры других пользователей.
Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.
Но копейки-то всё равно числами отражаются
Так копейки и в любых бухгалтерских документах цифрами отображаются.
Вы хотите сказать, что если мой документ не бухгалтерский, то и функция мне такая не нужна? Или быть может только в бухгалтерских документах отображаются суммы? Что это вообще за аргумент такой?
Здравствуйте!
Я написал эту функцию для заполнения бухгалтерских и других документов, в которых копейки отображаются цифрами. С вашем случаем, когда требуется копейки писать прописью, я не сталкивался. Мне приходилось перечислять часть зарплаты сотрудника по исполнительному листу, и даже в исполнительном листе копейки были напечатаны цифрами.
так и должно быть
Сохранила функцию, но формула работает только в этом файле, в других файлах excel не работает. как поправить? Спасибо.
Здравствуйте, Татьяна!
Чтобы функция была доступна во всех файлах на вашем компьютере, вставьте ее в личную книгу макросов.
А каким образом мне всё это закодировать? Хочу, чтобы в ячейке B1 выводился возврат значения числа из A1
Привет, Никита!
Код функции скопируйте и вставьте в модуль личной книги макросов, а в ячейку B1 — следующую формулу:
=PERSONAL.XLSB!СуммаПрописью(A1)
Кстати, эту формулу можно найти и вставить с помощью мастера функций из раздела «Определенные пользователем».
Функция прекрасно работает, спасибо!
Спасибо большое!
Супер функция!! Очень помогла! Огромное спасибо!
Обсуждение закрыто.