Отправляет email-рассылки с помощью сервиса Sendsay

Интересное и полезное в Инете и Рунете

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Средcтва продвижения сайтов в интернете" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Июнь 2008   →
 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
Автор
old_netler

Статистика

377 подписчиков
+2 за неделю
←   Все выпуски   →

Интересное и полезное в Инете и Рунете:как автоматизировать преобразование числа в сумму прописью


Выпуск № 25 (92)

«Интернет – это место, это среда, состоящая из людей и мириадов их взаимодействий. Это не просто технология, а новый способ сотрудничества, участия и заботы. Предприятия, которые признают гуманитарный аспект в Интернете, с большей вероятностью добьются успеха в искусственных мирах Электронной Эры, ибо они поймут, что все искусственное коренится в реальности, а реальность коренится в наших сердцах». (Vint Cerf)

 

Имею честь приветствовать Вас!

 

Excel: как автоматизировать преобразование числа в сумму прописью?

 

Программа Microsoft Office Excel может очень многое, но если вам показалось, что она чего-то не может, значит, нужно помочь ей.

Для этого можно использовать VBA (Visual Basic for Applications) – встроенную в офисный пакет версию макроязыка программирования Microsoft Visual Basic.

 

Допустим, в xls-файле какая-то ячейка (например, E13) является итоговой, но число в ней представлено, естественно, в числовом формате, а вам нужна еще и сумма прописью. Как быть? Можно попытаться «нагуглить» в Интернете какую-нибудь программу, а можно создать свою!

 

1. Выделите и объедините диапазон ячеек, в котором будет указана сумма прописью (например, A14–K14).

2. Щелкните левой кнопкой мыши в строке формул и введите следующий текст (укажите вместо E13 нужную вам ячейку):

=ЕСЛИ((E13)<=0;"Сумма прописью:_______________________________________";"Сумма прописью: "&FirstLetter(CurText(E13)))

3. Теперь займемся программированием:

– откройте меню Сервис –> Макрос –> Редактор Visual Basic (или нажмите Alt + F11);

– в открывшемся окне Microsoft Visual Basic выберите меню Insert –> Module;

– откроется окно Module1 (Code), введите в этом окне (без изменений!) следующий код:

 

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

 

Сохраните изменения в файле. Пользуйтесь!

 

Примечания

1. Рекомендации данной статьи предназначены для русифицированной версии Microsoft Office Excel XP/2003, в других версиях возможны незначительные отклонения.

2. Чтобы созданная нами программа работала:

– откройте меню Сервис –> Макрос –> Безопасность…;

– в открывшемся окне Безопасность на вкладке Уровень безопасности установите переключатель Низкая, на вкладке Надежные издатели установите флажки Доверять всем установленным надстройкам и шаблонам и Доверять доступ к Visual Basic Project –> OK.

3. Если вы не можете запустить Редактор Visual Basic (при этом могут быть недоступны опции Макрос и Редактор Visual Basic), то, как правило, это означает, что система заражена макровирусами.

 

Понемногу обо всем

«Яндекс» сделал Сеть доступной для всех мобильных устройств

«Яндекс» объявил о том, что теперь по ссылке из результатов поиска пользователь мобильного поискового сервиса компании может увидеть содержимое любого ресурса, адаптированное именно для его телефона. «Яндекс» автоматически определяет модель устройства пользователя и преобразует сайт в подходящий «телефонный» формат – даже если сам телефон не умеет корректно показывать веб-сайты.

Ключевые сервисы «Яндекса» – в том числе поиск, почта, новости и погода – также стали доступны для всех телефонов. Кроме того, появились новые возможности специально для мобильных пользователей Интернета. Например, на номера телефонов, найденные в поиске или присланные по почте, можно позвонить прямо из браузера. Кроме того, определяется регион, в котором находится пользователь – таким образом, он видит прогноз погоды или телепрограмму сразу для своего города.
 

 

Где скачать бесплатный софт

Snow Player 0.81

Нетребовательный к ресурсам и быстрый аудио/видео/радио плеер.

Что нового в версии 0.81:

возможность записи, поддержка CUE файлов, редактор ID3 тэгов, расширен список поддерживаемых кодеков и воспроизводимых видеоформатов, добавлены hotkeys, поиск описаний фильмов в базе imdb.

Условия использования: FreeWare – Бесплатная

Язык: русский, английский, французский.

Автор: R+ Studio

Дата выпуска: 2008-06-04

405КБ

Скачать: http://freesoft.ru/file.html?type=sc&id=674037&dl=0&filename=snowplayer.zip

 

Ускоритель модема 1.0

Данная программа ускоряет Интернет за счет оптимизации настроек модема. Программа позволяет вам оптимизировать ваше интернет-подключение и просматривать веб-сайты на более высокой скорости. Данная программа проста в использовании. Вам достаточно передвинуть ползунок на «Быстро» и нажать на кнопку «Ускорить модем», после чего перезагрузить компьютер и наслаждаться более стабильной и высокой скоростью Интернета.

Условия использования: FreeWare – Бесплатная

Язык: русский

ОС: Win95, Win98, WinME, WinNT, Win2000, WinXP, Win2003, WinVista

Автор: NorthByte Software

Дата выпуска: 2008-06-10

2МБ

Скачать: http://freesoft.ru/file.html?type=sc&id=674655&dl=0&filename=ModemBooster.exe

 

Antidote Free 1.0

Бесплатный антивирусный сканер с функцией обновления. Вирусная база – более миллиона записей. Без ограничения по возможностям детектирования вредоносного кода и лечения/удаления обнаруженных вирусов.

Данная программа не способна обеспечить постоянную антивирусную защиту системы (антивирусный монитор, сетевые фильтры и т.п.), но вполне может быть использована для поиска вирусов и лечения инфицированных компьютеров.

Может использоваться совместно с другими антивирусными продуктами.

Условия использования: FreeWare – Бесплатная

Язык: русский, английский

ОС: Win2000,WinXP,Win2003,WinVista

Автор: Antidote, LLC

Дата выпуска: 2008-06-09

10119КБ

Скачать: http://freesoft.ru/file.html?url=rep/674620/AntidoteFree1.0.exe

Всего Вам Доброго!

 

С уважением, old-netler

http://netler.ru/

http://old-netler.narod.ru/
В избранное