Листинг 1. Функция SummaString выполняет задачу «запись числа прописью»

Sub SummaString(Summa$, Source As Long, Rod%, w1$, w2to4$, _ 
        w5to10$) 
‘ 
‘ “Сумма прописью”: 
‘ преобразование числа из цифрового вида в символьное 
‘ ================================================== 
‘ Исходные данные: 
‘     Source - число от 0 до 2147483647 (2^31-1) 
       ‘   Если нужно оперировать с числами > 2 147 483 647, 
       ‘   замените описание переменных Source и TempValue на 
         ‘   “AS DOUBLE” 
‘ 
‘ Далее нужно задать информацию о единице изменения: 
‘      Rod% = 1 - мужской, = 2 - женский, = 3 - средний 
‘ Название единицы изменения: 
‘      w1$ - именительный падеж единственное число (= 1) 
‘      w2to4$ - родительный падеж единственное число (= 2-4) 
‘      w5to10$ - родительный падеж множественное число ( = 5-10) 
‘ 
‘ Параметр Rod% должен быть задан обязательно, 
‘ а название единицы 
‘ можно опустить = “” 
‘ ———————————————- 
‘ Результат: Summa$ - запись прописью 
‘ 
‘ 
‘ 
‘================================ 
      Dim TempValue As Long 
      ‘ 
      If Source& = 0 Then 
            Summa$ = RTrim$(“ноль “ + w5to10$): Exit Sub 
      End If 
      ‘ 
      TempValue = Source: Summa$ = “” 
      ‘    единицы 
      Call SummaStringThree(Summa$, TempValue, Rod%, w1$, _ 
           w2to4$, w5to10$) 
      If TempValue = 0 Then Exit Sub 
      ‘ тысячи 
      Call SummaStringThree(Summa$, TempValue, 2, “тысяча”, _ 
           “тысячи”, “тысяч”) 
      If TempValue = 0 Then Exit Sub 
      ‘ миллионы 
      Call SummaStringThree(Summa$, TempValue, 1, 
                   “миллион”, _ 
           “миллиона”, “миллионов”) 
      If TempValue = 0 Then Exit Sub 
      ‘ миллиарды 
      Call SummaStringThree(Summa$, TempValue, 1,
                    “миллиард”, _ 
           “миллиарда”, “миллиардов”) 
      If TempValue = 0 Then Exit Sub 
      ‘ 
      ‘ Если нужно оперировать с числами > 2 
      147 483 647, 
      ‘ измените тип переменных (см. выше) и добавьте 
      эту строку  
      ‘ для триллионов: 
      ‘ CALL SummaStringThree(Summa$, 
      TempValue#, 1, “триллион”, _ 
      “триллиона”, “триллионов”) 
      ‘ IF TempValue# = 0 THEN EXIT SUB 
      ‘ 
      ‘ Что идет после триллионов, трудно представить... 
      ‘ 
End Sub 
Sub SummaStringThree(Summa$, TempValue As Long, Rod%, 
                     w1$, _ 
      w2to4$, w5to10$) 
‘ 
‘ Формирование строки для трехзначного числа: 
‘ (последний из трех знаков TempValue) 
‘ Если нужно оперировать с числами > 2 147 483 647, 
‘ замените описание переменной TempValue на “AS DOUBLE” 
‘==================================== 
      Dim Rest%, Rest1%, EndWord$, s1$, s10$, s100$ 
      ‘ 
      Rest% = TempValue& Mod 1000 
      TempValue& = TempValue& \ 1000 
         If Rest% = 0 Then ‘ последние три знака нулевые 
            If Summa$ = “” Then Summa$ = w5to10$ + “ “ 
            Exit Sub 
      End If 
‘ 
‘ начинаем подсчет с Rest 
      EndWord$ = w5to10$ 
      ‘ сотни 
      Select Case Rest% \ 100 
             Case 0: s100$ = “” 
             Case 1: s100$ = “сто “ 
             Case 2: s100$ = “двести “ 
             Case 3: s100$ = “триста “ 
             Case 4: s100$ = “четыреста “ 
             Case 5: s100$ = “пятьсот “ 
             Case 6: s100$ = “шестьсот “ 
             Case 7: s100$ = “семьсот “ 
             Case 8: s100$ = “восемьсот “ 
             Case 9: s100$ = “девятьсот “ 
      End Select 
      ‘ 
      ‘ десятки 
      Rest% = Rest% Mod 100: Rest1% = Rest% \ 10 
      s1$ = “” 
      Select Case Rest1% 
              Case 0: s10$ = “” 
            Case 1 ‘ особый случай 
                       Select Case Rest% 
                         Case 10: s10$ = “десять “ 
                         Case 11: s10$ = “одиннадцать “ 
                         Case 12: s10$ = “двенадцать “ 
                         Case 13: s10$ = “тринадцать “ 
                         Case 14: s10$ = “четырнадцать “ 
                         Case 15: s10$ = “пятнадцать “ 
                         Case 16: s10$ = “шестнадцать “ 
                         Case 17: s10$ = “семнадцать “ 
                         Case 18: s10$ = “восемнадцать “ 
                         Case 19: s10$ = “девятнадцать “ 
               End Select 
            Case 2: s10$ = “двадцать “ 
            Case 3: s10$ = “тридцать “ 
            Case 4: s10$ = “сорок “ 
            Case 5: s10$ = “пятьдесят “ 
            Case 6: s10$ = “шестьдесят “ 
            Case 7: s10$ = “семьдесят “ 
            Case 8: s10$ = “восемьдесят “ 
            Case 9: s10$ = “девяносто “ 
      End Select 
      ‘ 
      If Rest1% <> 1 Then ‘ единицы 
            Select Case Rest% Mod 10 
                   Case 1 
                          Select Case Rod% 
                                 Case 1: s1$ = “один “ 
                                 Case 2: s1$ = “одна “ 
                                 Case 3: s1$ = “одно “ 
                          End Select 
                          EndWord$ = w1$ 
                   Case 2 
                          If Rod% = 2 
                   Then s1$ = “две “ Else s1$ = “два “ 
                          EndWord$ = w2to4$ 
                   Case 3: s1$ = “три “: EndWord$ = w2to4$ 
                   Case 4: s1$ = “четыре “: EndWord$ = w2to4$ 
                   Case 5: s1$ = “пять “ 
                   Case 6: s1$ = “шесть “ 
                   Case 7: s1$ = “семь “ 
                   Case 8: s1$ = “восемь “ 
                   Case 9: s1$ = “девять “ 
            End Select 
      End If 
      ‘ 
      ‘ сборка строки 
      Summa$ = RTrim$(RTrim$(s100$ + s10$ + s1$ 
      + EndWord$) + _ 
      “ “ + Summa$) 
End Sub