Lyuciena

0 0

О чем думаете?

 -Подписка по e-mail

 
Получать сообщения дневника на почту.

 -Поиск по дневнику

люди, музыка, видео, фото
Поиск сообщений в Lyuciena

 -Новостные сюжеты

 -Постоянные читатели

 -Сообщества

Участник сообществ (Всего в списке: 3) вязалочки Вязание Gazeta_Liru
Читатель сообществ (Всего в списке: 1) Ссылочки_малятам

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Дата регистрации: 21.05.2004
Записей в дневнике: 10
Комментариев в дневнике: 31
Написано сообщений: 82
Популярные отчеты:
кто смотрел дневник по каким фразам приходят

цифры прописью в Excel- макрос

Воскресенье, 20 Мая 2007 г. 22:53 (ссылка) + в цитатник или сообщество +поставить ссылку
Автор функции - П.В. Морозов
2. Требуется Excel 97 и выше, а также установленный и интегрированный в него редактор Visual Basic - обычно у всех установлен.
Путь:
Открыть Excel. Выбрать пункт меню: Сервис-Макрос-Редактор Visual Basic.
В нем пункт меню: вставка-модуль.
Откроется Книга1 модуля.
В этот лист вставить (или набрать) текст, который будет идти ниже - в комментарии. Просто выделите его и вставьте целиком, ничего не исправляя.

3. После того, как текст введен, нажать кнопку сохранить. В нижнем выпадающем списке выбрать тип файла: надстройка Microsoft Excel. Имя файла заменить на (например) СуммаПрописью и сохранить в папке Мои документы.
4. Закрыть редактор и Excel.
5. Опять открыть Excel – сервис- надстройки- обзор – найти в Мои документы СуммаПрописью, дважды щелкнуть, убедиться, что напротив надстройки стоит галочка и нажать ОК.
6. Ввести в ячейку, например, D1, число: 789 456 321,85.
Выделить другую ячейку, где вы ходите видеть это число прописью.
Вставка – функция, выбрать категорию Определенные пользователем – там будет одна функция ПРОПИСЬЮ, выбрать ее и нажать ОК. Появится окно ввода аргумента, в поле SorceDigits ввести адрес ячейки D1, где находится число – можно просто выделить эту ячейку, и ее адрес сам появится в поле, потом нажать ОК. Если текст введен правильно, все получится!
Замечания по самому тексту:
1. Пустые строки в тексте и абзацы значения не имеют. Просто так удобнее для визуального восприятия.
2. После каждого русского слова в кавычках, нужно оставлять пробел, чтобы текст не был слитным. Пример “десять “. В слове коп.пробел делать перед ним.
3. После сохранения, если все будет правильно, ключевые слова будут синего цвета. Если будет ошибка – красного. (У меня на домашнем компе «кривой» ексель, и цветом ничего не выделилось, но функция сама действует).
4. Ограничение для функции - миллионы.
5. КОпейки округляются до сотых.
6. Можно поменять рубль, рубля, рублей и коп. на доллары и цент. соответственно. Чтобы не запутаться в двух ПРОПИСЬЮ, во втором тексте в начале и конце текста в слове ПРОПИСЬЮ убрать букву Ю (например, тогда ПРОПИСЬЮ будет для рублей, а ПРОПИСЬ для баксов).
Сама функция в комментарии.



Цитаты
0
Ссылки
0
Запомнить в Evernote
Поделиться с друзьями

Lyuciena   0 0 обратиться по имени Воскресенье, 20 Мая 2007 г. 22:55 (ссылка)
Function ПРОПИСЬЮ (SourceDigits As Currency) As String
Dim STRNG As String, CHAR, Result As String, Prom As String
Dim I, STRNG_len As Long
Dim SourceDigTail As Currency

SourceDigTail = (SourceDigits – Int (SourceDigits)) * 100
SourceDigits = Int (SourceDigits)

STRNG = SourceDigits
STRNG_len = Len (STRNG)
For i = 1 To 9 - STRNG_len Step 1
STRNG = “0” & STRNG
Next i

For i = 9 To 9 - STRNG_len + 1 Step -1
CHAR = Mid (STRNG, i, 1)
If CHAR = “” Then GoTo end_c

If i = 2 Or i = 5 Or i = 8 Then
IF CHAR = “1” Then
CHAR = Mid (STRNG, i, 2)
Select Case CHAR
Case “10”
Prom = “десять ”
Case “11”
Prom = “одиннадцать ”
Case “12”
Prom = “двенадцать ”
Case “13”
Prom = “тринадцать ”
Case “14”
Prom = “четырнадцать ”
Case “15”
Prom = “пятнадцать ”
Case “16”
Prom = “шестнадцать ”
Case “17”
Prom = “семнадцать ”
Case “18”
Prom = “восемнадцать ”
Case “19”
Prom = “девятнадцать ”
End Select
Else ‘ If char Not = 1
Select Case CHAR
Case “0”
Prom = “ ”
Case “2”
Prom = “двадцать ”
Case “3”
Prom = “тридцать ”
Case “4”
Prom = “сорок ”
Case “5”
Prom = “пятьдесят ”
Case “6”
Prom = “шестьдесят ”
Case “7”
Prom = “семьдесят ”
Case “8”
Prom = “восемьдесят ”
Case “9”
Prom = “девяносто ”
End Select
End If
End If
If i = 1 Or i = 4 Or i = 7 Then
Select Case CHAR
Case “0”
Prom = “”
Case “1”
Prom = “сто ”
Case “2”
Prom = “двести ”
Case “3”
Prom = “триста ”
Case “4”
Prom = “четыреста ”
Case “5”
Prom = “пятьсот ”
Case “6”
Prom = “шестьсот ”
Case “7”
Prom = “семьсот ”
Case “9”
Prom = “девятьсот ”
End Select
End If
If i = 3 Or i = 6 Or i = 9 Then

If i = 9 And Mid (STRNG, i - 1, 1) = “1” Then
Result = “рублей ” & Result
GoTo end_c
End If



If i = 3 And Mid (STRNG, i - 1, 1) = “1” Then
Result = “миллионов ” & Result
GoTo end_c
End If



If i = 6 And Mid (STRNG, i - 1, 1) = “1” Then
Result = “тысяч ” & Result
GoTo end_c
End If

Select Case CHAR
Case “0”
Prom = “”
Case “1”
If i = 6 Then
Prom = “одна ”
Else
Prom = “один ”

End If
Case “2”

If i = 6 Then
Prom = “две ”
Else
Prom = “два ”
End If
Case “3”
Prom = “три ”

Case “4”
Prom = “четыре ”
Case “5”
Prom = “пять ”
Case “6”
Prom = “шесть ”
Case “7”
Prom = “семь ”
Case “8”
Prom = “восемь ”
Case “9”
Prom = “девять ”
End Select
End If
Select Case i

Case 3
Select Case CHAR
Case “1”
Result = “миллион ” & Result
Case “2” , “3”, “4”
Result = “миллиона ” & Result
Case “5”, “6”, “7”, “8” , “9”
Result = “миллионов ” & Result
Case “0”
If STRNG_len > 6 Then
Result = “миллионов ” & Result
End If
End Select


Case 6
Select Case CHAR
Case “1”
Result = “тысяча ” & Result
Case “2”, “3”, “4”
Result = “тысячи ” & Result
Case “5”, “6”, “7”, “8” , “9”
Result = “тысяч ” & Result
Case “0”
If STRNG_len > 3 Then
Result = “тысяч ” & Result
End If
End Select

Case 9
Select Case CHAR
Case “1”
Result = “рубль ” & Result
Case “2” , “3”, “4”
Result = “рубля ” & Result
Case “0”, “5”, “6”, “7” , “8” , “9”
Result = “рублей ” & Result
End Select
End Select

Result = Prom & Result

end_c:
Next i

Result = Format(Mid(Result, 1, 1), “>” ) & Mid (Result, 2)

ПРОПИСЬЮ = Result & Format (SourceDigTail, “00”) & “ коп.”

End Function
Ответить С цитатой В цитатник
Аноним   обратиться по имени Воскресенье, 04 Мая 2008 г. 22:51 (ссылка)
Работает отлично. Я белорусизировал. Но был пропущен разряд "восемьсот". Не шибко разбираясь в бейсике у себя ошибку исправил .
С уважением
Александр
slabada@tut.by
Ответить С цитатой В цитатник    |    Не показывать комментарий
Lyuciena   0 0 обратиться по имени Понедельник, 05 Мая 2008 г. 22:22 (ссылка)
А! Точно, пропущен. Спасибо, Александр.
Но принцип же понятен ))
Ответить С цитатой В цитатник
Аноним   обратиться по имени Пятница, 29 Мая 2009 г. 17:42 (ссылка)
Спасибо за программу отлично работает

Алишер Ташкент.
Ответить С цитатой В цитатник    |    Не показывать комментарий
Аноним   обратиться по имени Четверг, 11 Июня 2009 г. 14:24 (ссылка)
ПРОПИСЬЮ(1000000) возвращает "Один миллион ТЫСЯЧ рублей 00 коп."

На скорую руку исправил фрагмент:

Case "0"
If STRNG_len > 3 Then
Result = "тысяч " & Result
End If

придав ему вид:


Case "0"
If STRNG_len > 3 And Left(Right(STRNG, 6), 3) <> "000" Then
Result = "тысяч " & Result
End If

Вроде лишнее слово "тысяч" перестало возникать.

Еще хорошо бы в самое начало функции добавить строку:

Application.Volatile

зачем - почитайте в хелпе Excel :)

А вообще - большое спасибо! Пригодилась Ваша разработочка.

С уважением,
Константин, С-Петербург
Ответить С цитатой В цитатник    |    Не показывать комментарий
Lyuciena   0 0 обратиться по имени Четверг, 18 Июня 2009 г. 00:55 (ссылка)
Константин, на здоровье )
Только она не моя - автор некий П.В.Морозов. Когда-то я это взяла из какого-то забытого журнала...
Ответить С цитатой В цитатник
Аноним   обратиться по имени Пятница, 25 Сентября 2009 г. 12:45 (ссылка)
Здравствуйте,

когда хочу сохранить модуль, в списке ниже нет формата надстроек....как быть?
Ответить С цитатой В цитатник    |    Не показывать комментарий
 

Добавить комментарий:
Текст комментария: показать смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
Подписаться на комментарии
Подписать картинку

Подписаться
Отписаться
К дневнику Страницы:  [1] [Новые]
Copyright © 2002-2010 liveinternet.ru: показано количество просмотров и посетителей за 24 часа LiveInternet
Найти дневники