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.
Public Sub Main()
Debug.WriteLine(ЧислоПрописью( 3456832 . 71 ))
Debug.WriteLine(ЧислоПрописью( 3 . 2 , "м;метр;метра;метров", "м;дециметр;дециметра;дециметров;1,0"))
Debug.WriteLine(ЧислоПрописью( 3 . 71 , "м;метр;метра;метров", "м;милиметр;милиметра;милиметров;2,0"))
Debug.WriteLine(ЧислоПрописью( 32 . 102 , "ж|тонна|тонны|тонн", "м|килограмм|киллограмма|киллограмм|3 и ещё 0"))
Debug.WriteLine(ЧислоПрописью( 32 , "м;человек|человека|человек"))
Debug.WriteLine(ЧислоПрописью( 21 , "с;окно|окна|окон"))
Debug.WriteLine(ЧислоПрописью( 21 , "ж;дубинка|дубинки|дубинок"))
Debug.WriteLine(ЧислоПрописью( 21 , "ж;бутылка молока|бутылки молока|бутылок молока"))
Debug.WriteLine(ЧислоПрописью( 1277 , "ж;бутылка молока|бутылки молока|бутылок молока"))
'Три миллиона четыреста пятьдесят шесть тысяч восемьсот тридцать два рубля 71 копейка
'Три метра, 2 дециметра
'Три метра, 71 милиметр
'Тридцать две тонны и ещё 102 киллограмма
'Тридцать два человека
'Двадцать одно окно
'Двадцать одна дубинка
'Двадцать одна бутылка молока
'Одна тысяча двести семьдесят семь бутылок молока
End Sub
' PString1:
' "м|рубль|рубля|рублей"
' ^ - род наименования
' ^^^^^ - именительный падеж
' ^^^^^ - родительный падеж
' ^^^^^^ - родительный падеж множественного числа
' PString2:
' "ж|копейка|копейки|копеек|2,00"
' ^ - кол-во значащих знаков после запятой
' ^ - символ-разделитель (пробел если не нужен)
' ^^ - формат вывода числа дробной части
' ^ - род наименования
' ^^^^^^^ - именительный падеж
' ^^^^^^^ - родительный падеж
' ^^^^^^ - родительный падеж множественного числа
Public Function ЧислоПрописью(ByVal xsu As Object, _
Optional ByVal PString1 As String = "м|рубль|рубля|рублей", _
Optional ByVal PString2 As String = vbNullString) As String
Dim ssu As String, nsu As Byte, edi As Byte, des As Byte, sot As Byte, ind As Byte, i As Integer, v() As String, j As Integer, sb As New System.Text.StringBuilder
Dim r1 As String = "м", r10 As String = vbNullString, r11 As String = vbNullString, r12 As String = vbNullString
Dim r2 As String = vbNullString, r20 As String = vbNullString, r21 As String = vbNullString, r22 As String = vbNullString, _
r2_ As String = vbNullString, r2n As Short = 2 , r2s As String = "00"
On Error GoTo Err_
If Not IsNumeric(xsu) Then ЧислоПрописью = vbNullString : Exit Function
If xsu >= 10000000000000 Then ЧислоПрописью = "Слишком большое число" : Exit Function
If PString1 Is Nothing Then
PString2 = vbNullString
Else
PString1 = PString1.ToLower.Replace(";", "|")
If Not PString2 Is Nothing Then PString2 = PString2.ToLower.Replace(";", "|")
v = PString1.Split("|")
If v.Length >= 4 Then
If 0 = PString1.CompareTo("м|рубль|рубля|рублей") And PString2 Is Nothing Then
PString2 = "ж|копейка|копейки|копеек|2 00"
End If
r1 = v( 0 ).Substring( 0 , 1 )
r10 = v( 1 )
r11 = v( 2 )
r12 = v( 3 )
End If
End If
If Not PString2 Is Nothing Then
v = PString2.Split("|")
If v.Length = 4 Or v.Length = 5 Then
r2 = v( 0 ).Substring( 0 , 1 )
r20 = v( 1 )
r21 = v( 2 )
r22 = v( 3 )
If v.Length = 5 Then
r2n = CShort(v( 4 ).Substring( 0 , 1 ))
r2_ = v( 4 ).Substring( 1 , 1 ).Trim
r2s = v( 4 ).Substring( 2 ).Trim
If r2s.Length = 0 Then r2s = "0"
End If
End If
End If
If Fix(xsu) = 0 Then
sb.Append("ноль " & r12 & " ")
Else
If xsu < 0 Then sb.Append("минус ")
ssu = Fix(System.Math.Abs(xsu)).ToString ' строка рублей без знака
nsu = (ssu.Length + 2) \ 3 ' количество троек цифр
ssu = Right$("00", nsu * 3 - ssu.Length) + ssu ' добавляем нулями
For i = nsu To 1 Step -1
j = (nsu - i) * 3
sot = CByte(ssu.Substring(j, 1)) ' сотни
des = CByte(ssu.Substring(j + 1 , 1 )) ' десятки
edi = CByte(ssu.Substring(j + 2, 1)) ' единицы
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
sb.Append(Choose(sot, "сто", "двести", "триста", "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", "девятьсот") + " ")
End If
If des = 1 Then
sb.Append(Choose(edi + 1 , "десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать") + " ")
ind = 3
Else
If des <> 0 Then
sb.Append(Choose(des - 1 , "двадцать", "тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", "девяносто") + " ")
End If
If edi <> 0 Then ' вычисляем индекс для тысяч (одна,две)
ind = IIf(i = 2 And (edi = 1 Or edi = 2 ), 9 , 0 )
Select Case r1
Case "м" : sb.Append(Choose(edi + ind, "один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
Case "ж" : sb.Append(Choose(edi + ind, "одна", "две", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
Case Else : sb.Append(Choose(edi + ind, "одно", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", "две") + " ")
End Select
End If
Select Case edi
Case 1 : ind = 1
Case 2 To 4 : ind = 2
Case Else : ind = 3
End Select
End If
sb.Append(Choose((i - 1 ) * 3 + ind, r10, r11, r12, "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", "миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", "триллионов") & " ")
End If
Next i
End If
If Not r2 Is Nothing Then
ssu = Right(Format(xsu, ".000".Substring( 0 , r2n + 1 )), r2n)
If r2n > 1 Then des = CByte(ssu.Substring(r2n - 2 , 1 )) Else des = 0
edi = CByte(ssu.Substring(r2n - 1 , 1 ))
xsu = CShort((xsu - Fix(xsu)) * ( 10 ^ r2n))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1 : ind = 1
Case 2 To 4 : ind = 2
Case Else : ind = 3
End Select
End If
If r2.Length > 0 And Not r2_ Is Nothing Then
If r2_.Length > 0 And sb.Length Then sb.Insert(sb.Length - 1 , r2_)
End If
sb.Append(Format(xsu, r2s) & " " & Choose(ind, r20, r21, r22))
End If
ЧислоПрописью = sb.ToString.TrimEnd : sb = Nothing
Mid(ЧислоПрописью, 1 , 1 ) = Mid(ЧислоПрописью, 1 , 1 ).ToUpper
Exit Function
Err_:
ЧислоПрописью = "Ошибка числа прописью"
End Function
