Перевести 9 значное число в прописные.

[fizik_leha]

Нужна подпрограмка На VB переводящая числа из цифр в прописные.
Например было 11900000 стало Сто девятнадцать миллионов.

Может у кого завалялась

[alibek]

Таких в инете вагон и большая тележка.
Например, мой вариант:

Код: Выделить всё

Function LetterSum(Sum As Currency) As String
Dim R As Long, K As Integer, tmp As Integer
Dim Z As String, ZR As String, ZK As String
Const RKdiv = vbSpace2
R = Fix(Sum)
K = (Sum - R) * 100
ZR = IntTxt(R) + vbSpace + DTxt(R, "рублей", "рубль", "рубля")
ZK = Format$(K, "00") + vbSpace + DTxt(K, "копеек", "копейка", "копейки")
Z = ZR & RKdiv & ZK
Z = UCase$(Mid$(Z, 1, 1)) + Mid$(Z, 2)
LetterSum = Z
End Function

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
  If D(I) > 0 Then
    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 tmp <> "" Then Z = Z + tmp + " "
  End If
Next I
If Right$(Z, 1) = " " Then Z = Left$(Z, Len(Z) - 1)
IntTxt = Z
End Function

Function DTxt(Number As Variant, W0 As String, W1 As String, W2 As String) As String
Dim tmp As String, Z As Integer
tmp = Trim$(Str$(Number))
Z = Val(Right$(tmp, 2))
If Z < 20 Then
    Select Case Z
      Case 0, 5 To 19
        tmp = W0
      Case 1
        tmp = W1
      Case 2, 3, 4
        tmp = W2
    End Select
  Else
    Select Case (Z - 10 * Fix(Z / 10))
      Case 0, 5 To 9
        tmp = W0
      Case 1
        tmp = W1
      Case 2, 3, 4
        tmp = W2
    End Select
End If
DTxt = tmp
End Function


[fizik_leha]

Спасибо сейчас буду пробовать.