|
Function NumToText(ByVal Num As Double) As String
' Возвращает числовое значение прописью в виде текста
' Ххххх ххххх хххххх рублей YY копееек
Dim Num_, Num0, Num1, Num2, Num3, Num4, Num5, Num6, Num7, Num8 As Integer
Dim Dig(1 To 19) As String ' цифры и числа от 1 до 19
Dim Dec(1 To 10) As String ' десятки
Dim Sot(1 To 9) As String ' сотни
Dim strText1, strText2 As String
Dim L As Integer
Dig(1) = "один"
Dig(2) = "два"
Dig(3) = "три"
Dig(4) = "четыре"
Dig(5) = "пять"
Dig(6) = "шесть"
Dig(7) = "семь"
Dig(8) = "восемь"
Dig(9) = "девять"
Dig(10) = "десять"
Dig(11) = "одиннадцать"
Dig(12) = "двенадцать"
Dig(13) = "тринадцать"
Dig(14) = "четырнадцать"
Dig(15) = "пятнадцать"
Dig(16) = "шестнадцать"
Dig(17) = "семнадцать"
Dig(18) = "восемнадцать"
Dig(19) = "девятнадцать"
Dec(1) = "десять"
Dec(2) = "двадцать"
Dec(3) = "тридцать"
Dec(4) = "сорок"
Dec(5) = "пятьдесят"
Dec(6) = "шестьдесят"
Dec(7) = "семьдесят"
Dec(8) = "восемьдесят"
Dec(9) = "девяносто"
Sot(1) = "сто"
Sot(2) = "двести"
Sot(3) = "триста"
Sot(4) = "четыреста"
Sot(5) = "пятьсот"
Sot(6) = "шестьсот"
Sot(7) = "семьсот"
Sot(8) = "восемьсот"
Sot(9) = "девятьсот"
Num8 = Fix(Num / 100000000)
Num7 = Fix((Num - Num8 * 100000000) / 10000000)
Num6 = Fix((Num - Num8 * 100000000 - Num7 * 10000000) / 1000000)
Num5 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000) / 100000)
Num4 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000) / 10000)
Num3 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000) / 1000)
Num2 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000) / 100)
Num1 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100) / 10)
Num0 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100 - Num1 * 10))
Num_ = Fix((Num - Fix(Num)) * 100)
NumToText = ""
Select Case Num8 ' сотни миллионов
Case Is > 9
NumToText = "число > 999 999 999.99"
Case Is > 0
NumToText = NumToText & Sot(Num8)
End Select
Select Case Num7 ' десятки миллионов
Case Is > 1
NumToText = NumToText & " " & Dec(Num7)
Case Is = 1
If Num6 = 0 Then
NumToText = NumToText & " десять миллионов "
Else
NumToText = NumToText & " " & Dig(Num7 * 10 + Num6) & " миллионов "
End If
GoTo Tysachi
End Select
' единицы миллионов
If Num6 > 0 And Num7 <> 1 Then NumToText = NumToText & " " & Dig(Num6)
If NumToText <> "" Then
Select Case Num6
Case Is > 4
NumToText = NumToText & " миллионов "
Case Is > 1
NumToText = NumToText & " миллиона "
Case Is = 1
NumToText = NumToText & " миллион "
Case Is = 0
NumToText = NumToText & " миллионов "
End Select
End If
' сотни тысяч
Tysachi:
If Num5 > 0 Then NumToText = NumToText & " " & Sot(Num5)
Select Case Num4 ' десятки тысяч
Case Is > 1
NumToText = NumToText & " " & Dec(Num4)
Case Is = 1
If Num3 = 0 Then
NumToText = NumToText & " десять тысяч "
Else
NumToText = NumToText & " " & Dig(Num4 * 10 + Num3) & " тысяч "
End If
GoTo Rubl
End Select
' единицы тысяч
Select Case Num3
Case Is = 1
NumToText = NumToText & " одна"
Case Is = 2
NumToText = NumToText & " две"
Case Is > 2
NumToText = NumToText & " " & Dig(Num3)
End Select
If Num5 <> 0 Or Num4 <> 0 Or Num3 <> 0 Then
Select Case Num3
Case Is > 4
NumToText = NumToText & " тысяч "
Case Is > 1
NumToText = NumToText & " тысячи "
Case Is = 1
NumToText = NumToText & " тысяча "
Case Else
NumToText = NumToText & " тысяч "
End Select
End If
' сотни рублей
Rubl:
If Num2 > 0 Then NumToText = NumToText & Sot(Num2)
Select Case Num1 ' десятки рублей
Case Is > 1
NumToText = NumToText & " " & Dec(Num1)
Case Is = 1
If Num0 = 0 Then
NumToText = NumToText & " десять рублей"
Else
NumToText = NumToText & " " & Dig(Num1 * 10 + Num0) & " рублей"
End If
GoTo Kopeika
End Select
' единицы рублей
If Num0 > 0 And Num1 <> 1 Then NumToText = NumToText & " " & Dig(Num0)
Select Case Num0
Case Is > 4
NumToText = NumToText & " рублей "
Case Is > 1
NumToText = NumToText & " рубля "
Case Is = 1
NumToText = NumToText & " рубль "
Case Is = 0
NumToText = NumToText & " рублей "
End Select
Kopeika:
' копейки
NumToText = NumToText & " " & Format(Num_, "00")
Select Case Num_
Case Is > 4
NumToText = NumToText & " копеек"
Case Is > 1
NumToText = NumToText & " копейки"
Case Is = 1
NumToText = NumToText & " копейка"
Case Is = 0
NumToText = NumToText & " копеек"
End Select
' заглавная первая буква
NumToText = LTrim(NumToText)
L = Len(NumToText)
strText1 = Left(NumToText, 1)
strText2 = Right(NumToText, L - 1)
NumToText = UCase(strText1) & strText2
End Function | 
