Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос:  Число прописью! Добавлено: 27.10.08 04:34  

Автор вопроса:  kmsboy
Ребята! Может ли кто нить дать алгоритм на VBA для написания числа прописью! Заранее благодарен! (Excel 2003)

Ответить

  Ответы Всего ответов: 2  

Номер ответа: 1
Автор ответа:
 bi-lya



Вопросов: 1
Ответов: 125
  Профиль | | #1 Добавлено: 27.10.08 12:36
http://www.dimit.pochta.ru/wopr.html

Ответить

Номер ответа: 2
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #2 		Добавлено: 27.10.08 14:51
Мой пример для суммы в евро прописью:
  1. Public Function Propis(Summa As Double) As String
  2.     Dim t As String
  3.     Dim s() As String
  4.     Dim n(0 To 2) As Integer
  5.     Dim i As Integer
  6.     t = "один два три четыре пять шесть семь восемь девять десять одиннадцать двенадцать тринадцать четырнадцать пятнадцать шестнадцать семнадцать восемнадцать девятнадцать двадцать тридцать сорок пятьдесят шестьдесят семьдесят восемьдесят девяносто сто двести триста четыреста пятьсот шестьсот семьсот восемьсот девятьсот одна две тысяча тысячи тысяч евро цент цента центов ноль"
  7.     s = Split(t, " ")
  8.     If Summa > 999999.99 Or Summa < 0 Then Exit Function
  9.     t = Trim(Format(Summa, "# ##0.00"))
  10.     n(0) = CInt(Right$(t, 2))
  11.     t = Left$(t, InStr(1, t, ",") - 1)
  12.     If InStr(1, t, " ") = 0 Then
  13.         n(1) = CInt(t)
  14.         n(2) = 0
  15.     Else
  16.         n(1) = CInt(Mid$(t, InStr(1, t, " ") + 1))
  17.         n(2) = CInt(Left$(t, InStr(1, t, " ") - 1))
  18.     End If
  19.     t = ""
  20.     If n(2) > 0 Then
  21.         i = n(2) \ 100
  22.         If i > 0 Then
  23.             t = s(i + 26)
  24.         End If
  25.         i = n(2) - i * 100
  26.         If i > 0 Then
  27.             Select Case i
  28.                 Case Is = 1
  29.                     t = t & " " & s(36) & " " & s(38)
  30.                 Case Is = 2
  31.                     t = t & " " & s(37) & " " & s(39)
  32.                 Case 3 To 4
  33.                     t = t & " " & s(i - 1) & " " & s(39)
  34.                 Case 5 To 19
  35.                     t = t & " " & s(i - 1) & " " & s(40)
  36.                 Case 20 To 99
  37.                     t = t & " " & s(i \ 10 + 17)
  38.                     i = i Mod 10
  39.                     Select Case i
  40.                         Case Is = 0
  41.                             t = t & " " & s(40)
  42.                         Case Is = 1
  43.                             t = t & " " & s(36) & " " & s(38)
  44.                         Case Is = 2
  45.                             t = t & " " & s(37) & " " & s(39)
  46.                         Case 3 To 4
  47.                             t = t & " " & s(i - 1) & " " & s(39)
  48.                         Case 5 To 9
  49.                             t = t & " " & s(i - 1) & " " & s(40)
  50.                     End Select
  51.             End Select
  52.         Else
  53.             t = t & " " & s(40)
  54.         End If
  55.     End If
  56.     If n(1) > 0 Then
  57.         i = n(1) \ 100
  58.         If i > 0 Then
  59.             t = t & " " & s(i + 26)
  60.         End If
  61.         i = n(1) - i * 100
  62.         If i > 0 Then
  63.             Select Case i
  64.                 Case 1 To 19
  65.                     t = t & " " & s(i - 1)
  66.                 Case 20 To 99
  67.                     t = t & " " & s(i \ 10 + 17)
  68.                     i = i Mod 10
  69.                     If i > 0 Then
  70.                         t = t & " " & s(i - 1)
  71.                     End If
  72.             End Select
  73.         End If
  74.     End If
  75.     t = t & " " & s(41) & " " & Format$(n(0), "00")
  76.     Select Case n(0)
  77.         Case Is = 0
  78.             t = t & " " & s(44)
  79.         Case Is = 1
  80.             t = t & " " & s(42)
  81.         Case 2 To 4
  82.             t = t & " " & s(43)
  83.         Case 5 To 19
  84.             t = t & " " & s(44)
  85.         Case 20 To 99
  86.             i = n(0) Mod 10
  87.             Select Case i
  88.                 Case Is = 0
  89.                     t = t & " " & s(44)
  90.                 Case Is = 1
  91.                     t = t & " " & s(42)
  92.                 Case 2 To 4
  93.                     t = t & " " & s(43)
  94.                 Case 5 To 9
  95.                     t = t & " " & s(44)
  96.             End Select
  97.     End Select
  98.     t = Trim(t)
  99.     If n(2) = 0 And n(1) = 0 Then t = s(45) & " " & t
  100.     t = UCase(Left(t, 1)) & Mid(t, 2)
  101.     Propis = t
  102. End Function

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам