1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
Public Function СуммаПрописью1(Сумма As String) As String
On Error GoTo Func_Err
Dim LowSumma, Rub As String * 12, i As Integer
If Len(Сумма) < 4 Or (Left(Right(Сумма, 3), 1) <> "-" And Left(Right(Сумма, 3), 1) <> "," And Left(Right(Сумма, 3), 1) <> ".") Then
MsgBox "Неправильно введена сумма (нужно 0-00 или 0,00)"
Exit Function
ElseIf Len(Сумма) = 4 And Left(Сумма, 1) = 0 Then
LowSumma = "ноль "
End If
RSet Rub = Right(Left(Сумма, Len(Сумма) - 3), Len(Rub))
For i = 1 To 9
Mid(Rub, i, 1) = IIf(Mid(Rub, i, 1) = " ", "0", Mid(Rub, i, 1))
Next
For i = Len(Rub) / 3 To 1 Step -1
LowSumma = LowSumma & Сотни(Mid(Rub, Len(Rub) - i * 3 + 1, 3), i = 2)
LowSumma = LowSumma & Razr(i, Mid(Rub, Len(Rub) - i * 3 + 1, 3))
Next
СуммаПрописью1 = UCase(Left(LowSumma, 1)) & Right(LowSumma, Len(LowSumma) - 1) & Right(Сумма, 2) & Razr(0, Right(Сумма, 2))
Func_Exit:
Exit Function
Func_Err:
MsgBox Err.Description
Resume Next
End Function
Function Сотни(str As String, Optional bool As Boolean) As String
On Error GoTo Func_Err
Select Case Left(str, 1)
Case 0
Сотни = Десятки(Right(str, Len(str) - 1), bool)
Case 1
Сотни = "сто " & Десятки(Right(str, 2), bool)
Case 2
Сотни = "двести " & Десятки(Right(str, 2), bool)
Case 3
Сотни = "триста " & Десятки(Right(str, 2), bool)
Case 4
Сотни = "четыреста " & Десятки(Right(str, 2), bool)
Case 5
Сотни = "пятьсот " & Десятки(Right(str, 2), bool)
Case 6
Сотни = "шестьсот " & Десятки(Right(str, 2), bool)
Case 7
Сотни = "семьсот " & Десятки(Right(str, 2), bool)
Case 8
Сотни = "восемьсот " & Десятки(Right(str, 2), bool)
Case 9
Сотни = "девятьсот " & Десятки(Right(str, 2), bool)
End Select
Func_Exit:
Exit Function
Func_Err:
MsgBox Err.Description
Resume Next
End Function
Public Function Десятки(str As String, Optional bool As Boolean) As String
On Error GoTo Func_Err
Select Case Left(str, 1)
Case 0
Десятки = Единицы(Right(str, Len(str) - 1), bool)
Case 1
Select Case Mid(str, 2, 1)
Case 0
Десятки = "десять "
Case 1
Десятки = "одиннадцать "
Case 2
Десятки = "двенадцать "
Case 3
Десятки = "тринадцать "
Case 4
Десятки = "четырнадцать "
Case 5
Десятки = "пятнадцать "
Case 6
Десятки = "шестнадцать "
Case 7
Десятки = "семнадцать "
Case 8
Десятки = "восемнадцать "
Case 9
Десятки = "девятнадцать "
End Select
Case 2
Десятки = "двадцать " & Единицы(Right(str, 1), bool)
Case 3
Десятки = "тридцать " & Единицы(Right(str, 1), bool)
Case 4
Десятки = "сорок " & Единицы(Right(str, 1), bool)
Case 5
Десятки = "пятьдесят " & Единицы(Right(str, 1), bool)
Case 6
Десятки = "шестьдесят " & Единицы(Right(str, 1), bool)
Case 7
Десятки = "семьдесят " & Единицы(Right(str, 1), bool)
Case 8
Десятки = "восемьдесят " & Единицы(Right(str, 1), bool)
Case 9
Десятки = "девяносто " & Единицы(Right(str, 1), bool)
End Select
Func_Exit:
Exit Function
Func_Err:
MsgBox Err.Description
Resume Next
End Function
Function Единицы(str As String, Optional bool As Boolean) As String
On Error GoTo Func_Err
Select Case Left(str, 1)
Case 0
Единицы = ""
Case 1
Единицы = IIf(bool, "одна ", "один ")
Case 2
Единицы = IIf(bool, "две ", "два ")
Case 3
Единицы = "три "
Case 4
Единицы = "четыре "
Case 5
Единицы = "пять "
Case 6
Единицы = "шесть "
Case 7
Единицы = "семь "
Case 8
Единицы = "восемь "
Case 9
Единицы = "девять "
End Select
Func_Exit:
Exit Function
Func_Err:
MsgBox Err.Description
Resume Next
End Function
Function Razr(i As Integer, str As String) As String
On Error GoTo Func_Err
Select Case i
Case 0
Razr = IIf(Left(Right(str, 2), 1) <> 1, IIf(Right(str, 1) = 1, " копейка ", IIf(((Right(str, 1) = 2) Or (Right(str, 1) = 3) Or (Right(str, 1) = 4)), " копейки ", " копеек ")), " копеек ")
Case 1
Razr = IIf(Left(Right(str, 2), 1) <> 1, IIf(Right(str, 1) = 1, "рубль ", IIf(((Right(str, 1) = 2) Or (Right(str, 1) = 3) Or (Right(str, 1) = 4)), "рубля ", "рублей ")), "рублей ")
Case 2
Razr = IIf(CInt(Left(str, 3)) = 0, "", IIf(Left(Right(str, 2), 1) <> 1, IIf(Right(str, 1) = 1, "тысяча ", IIf(((Right(str, 1) = 2) Or (Right(str, 1) = 3) Or (Right(str, 1) = 4)), "тысячи ", "тысяч ")), "тысяч "))
Case 3
Razr = IIf(CInt(Left(str, 3)) = 0, "", IIf(Left(Right(str, 2), 1) <> 1, IIf(Right(str, 1) = 1, "миллион ", IIf(((Right(str, 1) = 2) Or (Right(str, 1) = 3) Or (Right(str, 1) = 4)), "миллиона ", "миллионов ")), "миллионов "))
Case 4
Razr = IIf(CInt(Left(str, 3)) = 0, "", IIf(Left(Right(str, 2), 1) <> 1, IIf(Right(str, 1) = 1, "миллиард ", IIf(((Right(str, 1) = 2) Or (Right(str, 1) = 3) Or (Right(str, 1) = 4)), "миллиарда ", "миллиардов ")), "миллиардов "))
End Select
Func_Exit:
Exit Function
Func_Err:
MsgBox Err.Description
Resume Next
End Function
