Огромное спасибо!!!
Огромное спасибо!!!
Объясните следующей тупой: это как конкретно понимать по шагам сделать ?Спасибо.
А вообще я даже не могла представить что эту тему можно было поднять...ооочень много лет стояла эта проблема..щас начну изобретать вернее пробовать тоже сделать..но не верю, аж, что получится,ну не верю.
иначе -будет счастье.
В Excel-2003 личная книга макросов называется PERSONAL.XLS и находится в
C:\Documents and Settings\пользователь\Application Data\Microsoft\Excel\XLSTART
Если книги нет, она создается автоматически при первой записи макроса в эту книгу: включить макрорекодер, в окошке "Запись макроса" выбрать "Сохранить в личную книгу макросов".
И - да будет счастье
За основу брал макрос OLaf.
Исправлена отекстовка для первой 9-ки.
Кроме рублей и долларов добавлены евро, гривны, внесение иной валюты без склонения, опускание наименования валют и сотые: копейки, центы. Сотые добавляются автоматом, если они есть в числе. Добавлен VB атрибут макроса, чтобы было видно описание макроса и аргументов при вызове.
А если я хочу что бы сумма прописью писалась на русском языке но за место рублей был узбекский сум?
С 2004 года для написания различных бухгалтерских документов, отчетов и т.п. пользуюсь для Office 2003, 2007 приложенным файлом. Инструкция по установке приложена. Работает безупречно. Пытался неоднократно найти что-то по-лучше, но ничего не нашел. Выводит прописью число,или в руб. и копейках, или в валюте
Ребята помогите пожалуйста сделать чтоб писало:
белорусских рублей и без копеек
И я не могу в книге в которой нужно это сделать добавить макрокс, там стоит пароль и макроксы все отключены. Как это обойти?
Макросы разрешить просто: меню Сервис-Макрос-Безопасность-Уровень_безопасности-Низкий (Средний).
В следующей открываемой книге макросы уже разрешены.
С паролем сложнее. Вы не пробовали войти в закрытую на замок дверь? Хотя воры заходят...
все сделал нормально, только нужно чтобы с большой буквы писало, как это сделать?
Function Число_в_текст(SumBase As Double, Valuta As Boolean)
Dim Edinicy(0 To 19) As String
Dim Desyatki(0 To 9) As String
Dim Sotni(0 To 9) As String
Dim mlrd(0 To 9) As String
Dim mln(0 To 9) As String
Dim tys(0 To 9) As String
Dim SumInt, x, shag, vl As Integer
Dim txt, Sclon_Tys As String
'---------------------------------------------
Application.Volatile
'---------------------------------------------
Edinicy(0) = ""
Edinicy(1) = "один "
Edinicy(2) = "два "
Edinicy(3) = "три "
Edinicy(4) = "четыре "
Edinicy(5) = "пять "
Edinicy(6) = "шесть "
Edinicy(7) = "семь "
Edinicy(8) = "восемь "
Edinicy(9) = "девять "
Edinicy(11) = "одиннадцать "
Edinicy(12) = "двенадцать "
Edinicy(13) = "тринадцать "
Edinicy(14) = "четырнадцать "
Edinicy(15) = "пятнадцать "
Edinicy(16) = "шестнадцать "
Edinicy(17) = "семнадцать "
Edinicy(18) = "восемнадцать "
Edinicy(19) = "девятнадцать "
'---------------------------------------------
Desyatki(0) = ""
Desyatki(1) = "десять "
Desyatki(2) = "двадцать "
Desyatki(3) = "тридцать "
Desyatki(4) = "сорок "
Desyatki(5) = "пятьдесят "
Desyatki(6) = "шестьдесят "
Desyatki(7) = "семьдесят "
Desyatki(8) = "восемьдесят "
Desyatki(9) = "девяносто "
'---------------------------------------------
Sotni(0) = ""
Sotni(1) = "сто "
Sotni(2) = "двести "
Sotni(3) = "триста "
Sotni(4) = "четыреста "
Sotni(5) = "пятьсот "
Sotni(6) = "шестьсот "
Sotni(7) = "семьсот "
Sotni(8) = "восемьсот "
Sotni(9) = "девятьсот "
'---------------------------------------------
mlrd(0) = "миллиардов "
mlrd(1) = "миллиард "
mlrd(2) = "миллиарда "
mlrd(3) = "миллиарда "
mlrd(4) = "миллиарда "
mlrd(5) = "миллиардов "
mlrd(6) = "миллиардов "
mlrd(7) = "миллиардов "
mlrd(8) = "миллиардов "
mlrd(9) = "миллиардов "
'---------------------------------------------
mln(0) = "миллионов "
mln(1) = "миллион "
mln(2) = "миллиона "
mln(3) = "миллиона "
mln(4) = "миллиона "
mln(5) = "миллионов "
mln(6) = "миллионов "
mln(7) = "миллионов "
mln(8) = "миллионов "
mln(9) = "миллионов "
'---------------------------------------------
tys(0) = "тысяч "
tys(1) = "тысяча "
tys(2) = "тысячи "
tys(3) = "тысячи "
tys(4) = "тысячи "
tys(5) = "тысяч "
tys(6) = "тысяч "
tys(7) = "тысяч "
tys(8) = "тысяч "
tys(9) = "тысяч "
'---------------------------------------------
On Error Resume Next
SumInt = Int(SumBase)
For x = Len(SumInt) To 1 Step -1
shag = shag + 1
Select Case x
Case 12 ' - сотни миллиардов
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 11 ' - десятки миллиардов
vl = Mid(SumInt, shag, 1)
If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
Case 10 ' - единицы миллиардов
vl = Mid(SumInt, shag, 1)
If shag > 1 Then
If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллиардов " Else txt = txt & Edinicy(vl) & mlrd(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады
Else
txt = txt & Edinicy(vl) & mlrd(vl)
End If
'-КОНЕЦ БЛОКА_______________________
Case 9 ' - сотни миллионов
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 8 ' - десятки миллионов
vl = Mid(SumInt, shag, 1)
If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
Case 7 ' - единицы миллионов
vl = Mid(SumInt, shag, 1)
If shag > 2 Then
If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10
End If
If shag > 1 Then
If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллионов " Else: txt = txt & Edinicy(vl) & mln(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады
Else
txt = txt & Edinicy(vl) & mln(vl)
End If
'-КОНЕЦ БЛОКА_______________________
Case 6 ' - сотни тысяч
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 5 ' - десятки тысяч
vl = Mid(SumInt, shag, 1)
If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
Case 4 ' - единицы тысяч
vl = Mid(SumInt, shag, 1)
If shag > 2 Then
If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10
End If
Sclon_Tys = Edinicy(vl) & tys(vl) ' - вводим переменную Sclon_Tys из-за иного склонения тысяч в русском языке
If vl = 1 Then Sclon_Tys = "одна " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys )
If vl = 2 Then Sclon_Tys = "две " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys )
If shag > 1 Then
If Mid(SumInt, shag - 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag - 1, 2)) & "тысяч "
End If
txt = txt & Sclon_Tys
'-КОНЕЦ БЛОКА_______________________
Case 3 ' - сотни
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 2 ' - десятки
vl = Mid(SumInt, shag, 1)
If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки
Case 1 ' - единицы
vl = Mid(SumInt, shag, 1)
If shag > 2 Then
If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo 10
End If
If shag > 1 Then
If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) Else: txt = txt & Edinicy(vl)
Else
txt = txt & Edinicy(vl)
End If
'-КОНЕЦ БЛОКА_______________________
End Select
10: Next x
Select Case Valuta
Case True
If vl = 0 Or vl > 4 Or (Mid(SumInt, shag - 1, 2) > 10 And Mid(SumInt, shag - 1, 2) < 20) Then
txt = txt + "белорусских рублей"
Else
If vl = 1 Then txt = txt + "белорусский рубль" Else txt = txt + "белорусских рубля"
End If
Case False
If vl = 0 Or vl > 4 Or (Mid(SumInt, shag - 1, 2) > 10 And Mid(SumInt, shag - 1, 2) < 20) Then
txt = txt + "долларов"
Else
If vl = 1 Then txt = txt + "доллар" Else txt = txt + "доллара"
End If
End Select
Число_в_текст = txt
End Function
Olaf, спасибо огромное за функцию СуммаПропись!!! Лет восемь мучилась вручную прописывать в документах ))))
Для того, чтобы функция от recidivist1 выводила текст с заглавной буквы, последнюю строку нужно доработать:
Но функция остается недоработанной. Например, показывает: Два белорусских рублейКод:...Число_в_текст = Replace(txt, Left(txt, 1), UCase(Left(txt, 1)), , 1) End Function
Спасибо за надстройку
Эту тему просматривают: 1 (пользователей: 0 , гостей: 1)