Главная » 2013 » Апрель » 16 » Excel: как автоматизировать преобразование числа в число прописью?
13:36
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), то, как правило, это означает, что система заражена макровирусами.
Категория: excel легко | Просмотров: 1089 | Добавил: antina | Теги: как автоматизировать преобразование, excel | Рейтинг: 0.0/0
Всего комментариев: 0
avatar