Сумма в Excel прописью
Вместо юзера проставляем имя пользователя. Также стоит помнить, возможно, придется сначала сделать папку Application Data не скрытой.
А затем – еще один шаг, чтобы сумма Excel отображалась прописью. Запустите проводник, поместите скачанную надстройку в папку. Теперь у вас в списке доступных надстроек есть «Сумма Прописью». Устанавливаем рядом с ней флажок и подтверждаем, нажимая ОК. теперь эта функция Вам доступна.
Второй вариант – использование макросов. Мы объединяем диапазон, где нужна сумма Excel прописью. В строке формул ставим это:
=ЕСЛИ((К9)<=0;"Сумма прописью:_______________________________________";"Сумма прописью: "&FirstLetter(CurText(E13)))
указываем нужную ячейку вместо К9
Затем открываем редактор VBA и в открытом окне Модуль ставим этот код без изменений:
Function Cur_txt1(cur As Currency, gender As String) As String
Dim str As String
Dim word As String
Dim digital As Integer
Dim c As Currency
c = cur
word = ""
If c < 1000 Then
digital = Int(c / 100)
Select Case digital
Case 1
word = "сто"
Case 2
word = "двести"
Case 3
word = "триста"
Case 4
word = "четыреста"
Case 5
word = "пятьсот"
Case 6
word = "шестьсот"
Case 7
word = "семьсот"
Case 8
word = "восемьсот"
Case 9
word = "девятьсот"
End Select
str = word
word = ""
c = c - digital * 100
If c > 19 Then
digital = Int(c / 10)
Select Case digital
Case 2
word = "двадцать"
Case 3
word = "тридцать"
Case 4
word = "сорок"
Case 5
word = "пятьдесят"
Case 6
word = "шестьдесят"
Case 7
word = "семьдесят"
Case 8
word = "восемьдесят"
Case 9
word = "девяносто"
End Select
If word "" Then
If str "" Then
str = str + " " + word
Else
str = word
End If
End If
word = ""
c = c - digital * 10
End If
Select Case c
Case 1
word = "один"
Case 2
word = "два"
Case 3
word = "три"
Case 4
word = "четыре"
Case 5
word = "пять"
Case 6
word = "шесть"
Case 7
word = "семь"
Case 8
word = "восемь"
Case 9
word = "девять"
Case 10
word = "десять"
Case 11
word = "одиннадцать"
Case 12
word = "двенадцать"
Case 13
word = "тринадцать"
Case 14
word = "четырнадцать"
Case 15
word = "пятнадцать"
Case 16
word = "шестнадцать"
Case 17
word = "семнадцать"
Case 18
word = "восемнадцать"
Case 19
word = "девятнадцать"
End Select
If (c <= 2) And ((gender = "w") Or (gender = "W")) Then
Select Case c
Case 1
word = "одна"
Case 2
word = "две"
End Select
End If
If word "" Then
If str "" Then
str = str + " " + word
Else
str = word
End If
End If
Else
If c < 1000000 Then
str = Cur_txt1(Int(c / 1000), "w")
word = ""
Select Case Int(c / 1000) Mod 10
Case 1
If Int(c / 1000) Mod 100 = 11 Then
word = "тысяч"
Else
word = "тысяча"
End If
Case 2, 3, 4
If (Int(c / 1000) Mod 100 > 10) And (Int(c / 1000) Mod 100 < 20) Then
word = "тысяч"
Else
word = "тысячи"
End If
Case Else
word = "тысяч"
End Select
If word "" Then
str = str + " " + word
End If
word = Cur_txt1(c - Int(c / 1000) * 1000, "m")
If word "" Then
str = str + " " + word
End If
Else
If c < 1000000000 Then
str = Cur_txt1(Int(c / 1000000), "m")
Select Case Int(c / 1000000) Mod 10
Case 1
If Int(c / 1000000) Mod 100 = 11 Then
word = "миллионов"
Else
word = "миллион"
End If
Case 2, 3, 4
If (Int(c / 1000000) Mod 100 > 10) And (Int(c / 1000000) Mod 100 < 20) Then
word = "миллионов"
Else
word = "миллиона"
End If
Case Else
word = "миллионов"
End Select
str = str + " " + word
word = Cur_txt1(c - Int(c / 1000000) * 1000000, "m")
If word "" Then
str = str + " " + word
End If
Else
End If
End If
End If
Cur_txt1 = str
End Function
Public Function CurText(cur As Currency) As String
Dim tmp As String
If cur < 1000000000 Then
tmp = ""
If cur >= 1 Then
tmp = Cur_txt1(Int(cur), "m") & " руб."
End If
If cur - Int(cur) >= 0.1 Then
tmp = tmp & " " & Int((cur - Int(cur)) * 100) & " коп."
Else
tmp = tmp & " 0" & Int((cur - Int(cur)) * 100) & " коп."
End If
CurText = tmp
Else
CurText = ""
End If
End Function
Public Function FirstLetter(str As String) As String
If str "" Then
FirstLetter = UCase(Left(str, 1)) + Right(str, Len(str) - 1)
Else
FirstLetter = ""
End If
End Function
После этого сумма в Excel также будет прописью. Нужно также открыть Сервис – Макрос – Безопасность и в этом окне поставить Низкий уровень безопасности, а на вкладке Надежные издатели вам следует поставить флажок Доверять надстроякам и шаблонам и Доверять доступ к VB Project.
- 13/12/2010 18:20 - Анализ в Excel
- 13/12/2010 17:48 - Вычисления в Excel: два способа
- 13/12/2010 17:47 - Excel формулы
- 13/12/2010 17:44 - Функции Excel
- 13/12/2010 16:45 - Расчеты в excel
- 08/07/2010 06:47 - Техника ввода данных Microsoft Excel