'-------------------------------------------------------
'Функция IntTxt печатает в поле прописью сумму,
'набранную цифрами в другом поле без названия
'денежных единиц.
'Используется совместно с функцией LetterSum.
'-------------------------------------------------------
Function IntTxt(Number As Long) As String
Dim Z As String, tmp As String
Dim I As Integer, P As Integer, N As Integer, V As Integer
If Number = 0 Then
  IntTxt = "ноль"
  Exit Function
End If
Z = Trim$(Str$(Number))
N = Fix((Len(Z) - 1) / 3)
ReDim D(0 To N) As Integer
For I = Len(Z) To 1 Step -1
  P = Fix((Len(Z) - I) / 3)
  tmp = Mid$(Z, I, 1) + tmp
  D(P) = Val(tmp)
  If Len(tmp) = 3 Then tmp = ""
Next I
Z = ""
For I = N To 0 Step -1
  V = D(I)
  P = Int(V / 100)
  Select Case P
    Case 0
    Case 1
      Z = Z + "сто "
    Case 2
      Z = Z + "двести "
    Case 3
      Z = Z + "триста "
    Case 4
      Z = Z + "четыреста "
    Case 5
      Z = Z + "пятьсот "
    Case 6
      Z = Z + "шестьсот "
    Case 7
      Z = Z + "семьсот "
    Case 8
      Z = Z + "восемьсот "
    Case 9
      Z = Z + "девятьсот "
  End Select
  P = V - 100 * Int(V / 100)
  Select Case Int(P / 10)
    Case 0
    Case 1
      Select Case P - 10 * Int(P / 10)
        Case 0
          Z = Z + "десять "
        Case 1
          Z = Z + "оди"
        Case 2
          Z = Z + "две"
        Case 3
          Z = Z + "три"
        Case 4
          Z = Z + "четыр"
        Case 5
          Z = Z + "пят"
        Case 6
          Z = Z + "шест"
        Case 7
          Z = Z + "сем"
        Case 8
          Z = Z + "восем"
        Case 9
          Z = Z + "девят"
      End Select
      If (P - 10 * Int(P / 10)) <> 0 Then Z = Z + "надцать "
    Case 2
      Z = Z + "двадцать "
    Case 3
      Z = Z + "тридцать "
    Case 4
      Z = Z + "сорок "
    Case 5
      Z = Z + "пятьдесят "
    Case 6
      Z = Z + "шестьдесят "
    Case 7
      Z = Z + "семьдесят "
    Case 8
      Z = Z + "восемьдесят "
    Case 9
      Z = Z + "девяносто "
  End Select
  If (Int(P / 10)) <> 1 Then
    Select Case P - 10 * Int(P / 10)
      Case 0
      Case 1
        Select Case I
          Case 1
            Z = Z + "одна "
          Case Else
            Z = Z + "один "
        End Select
      Case 2
        Select Case I
          Case 1
            Z = Z + "две "
          Case Else
            Z = Z + "два "
        End Select
      Case 3
        Z = Z + "три "
      Case 4
        Z = Z + "четыре "
      Case 5
        Z = Z + "пять "
      Case 6
        Z = Z + "шесть "
      Case 7
        Z = Z + "семь "
      Case 8
        Z = Z + "восемь "
      Case 9
        Z = Z + "девять "
    End Select
  End If
  Select Case I
    Case 0
      tmp = ""
    Case 1
      tmp = DTxt(V, "тысяча", "тысячи", "тысяч")
    Case 2
      tmp = DTxt(V, "миллион", "миллиона", "миллионов")
    Case 3
      tmp = DTxt(V, "миллиард", "миллиарда", "миллиардов")
    Case Else
      tmp = "#"
  End Select
  If I > 0 Then Z = Z + tmp + " "
Next I
IntTxt = Z
End Function
 

 

Hosted by uCoz