|
Поделитесь с новичком(ф-ция сумма пропись для Ворд)
#33015981
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
4321отмодерировано
Скопируй ф-ю из акса, и отладь ее ручками.
я могу ее здесь разместить, поможешь в ворд вставить и объяснить, как ее вызвать?
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.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
'''''''''''''''''''''''''''''''''''''
' Функция выводить сумму прописью '
' Вход: Сумма число '
' Выход: Сумма прописью '
'''''''''''''''''''''''''''''''''''''
Function SummaPropis(ByVal tt As Variant) As String
On Error GoTo Err_SummaPropis
Dim count As Integer, i As Integer, n As Integer, l As Integer
Dim kop As String, snum As String, s As String, e As String, t As String
Dim text As String
Static m1( 8 ) As String
Static m2( 8 ) As String
Static m3( 8 ) As String
Static mm( 8 ) As String
Static prob As String
m1( 0 ) = "сто"
m1( 1 ) = "двести"
m1( 2 ) = "триста"
m1( 3 ) = "четыреста"
m1( 4 ) = "пятьсот"
m1( 5 ) = "шестьсот"
m1( 6 ) = "семьсот"
m1( 7 ) = "восемьсот"
m1( 8 ) = "девятьсот"
m2( 0 ) = "десять"
m2( 1 ) = "двадцать"
m2( 2 ) = "тридцать"
m2( 3 ) = "сорок"
m2( 4 ) = "пятьдесят"
m2( 5 ) = "шестьдесят"
m2( 6 ) = "семьдесят"
m2( 7 ) = "восемьдесят"
m2( 8 ) = "девяносто"
m3( 0 ) = "один"
m3( 1 ) = "два"
m3( 2 ) = "три"
m3( 3 ) = "четыре"
m3( 4 ) = "пять"
m3( 5 ) = "шесть"
m3( 6 ) = "семь"
m3( 7 ) = "восемь"
m3( 8 ) = "девять"
mm( 0 ) = "одиннадцать"
mm( 1 ) = "двенадцать"
mm( 2 ) = "тринадцать"
mm( 3 ) = "четырнадцать"
mm( 4 ) = "пятнадцать"
mm( 5 ) = "шестнадцать"
mm( 6 ) = "семнадцать"
mm( 7 ) = "восемнадцать"
mm( 8 ) = "девятнадцать"
prob = " "
t = Format(tt, "000000000000.00")
i = 0
Do
i = i + 1
Loop While Mid$(t, i, 1 ) = "0"
i = i - 1
e = String$(i, 32 )
t = right$(t, 15 - i)
t = e & t
count = 4
kop = right$(t, 2 )
text = Left$(t, 12 )
snum = ""
i = 1
Do While count > 0
s = Mid$(text, i, 1 )
If s <> " " And s <> "0" Then
n = Val(s) - 1
snum = snum & m1(n)
snum = snum & prob
End If
i = i + 1
s = Mid$(text, i, 1 )
If s <> " " And s <> "0" And s <> "1" Then
n = Val(s) - 1
snum = snum & m2(n) & prob
End If
i = i + 1
s = Mid$(text, i, 1 )
If s <> " " And s <> "0" Then
If Mid$(text, i - 1 , 1 ) = "1" Then
n = Val(s) - 1
snum = snum & mm(n) & prob
Else
n = Val(s) - 1
snum = snum & m3(n) & prob
End If
End If
If s = "0" And Mid$(text, i - 1 , 1 ) = "1" Then
snum = snum & m2( 0 ) & prob
End If
If s <> " " Then
Select Case count
Case 4 :
Select Case s
Case "1":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиард "
Else
GoTo mi
End If
Case "2":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиарда "
Else
GoTo mi
End If
Case "3":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиарда "
Else
GoTo mi
End If
Case "4":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиарда "
Else
GoTo mi
End If
Case Else
mi: snum = snum & "миллиардов "
End Select
Case 3 :
Select Case s
Case "1":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллион "
Else
GoTo ma
End If
Case "2":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиона "
Else
GoTo ma
End If
Case "3":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиона "
Else
GoTo ma
End If
Case "4":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "миллиона "
Else
GoTo ma
End If
Case Else
ma: If Mid$(text, i - 2 , 1 ) = "0" And Mid$(text, i - 1 , 1 ) = "0" And s = "0" Then
Else
snum = snum & "миллионов "
End If
End Select
Case 2 :
Select Case s
Case "1":
If Mid$(text, i - 1 , 1 ) <> "1" Then
l = Len(snum) - 3
snum = Left$(snum, l)
snum = snum & "на тысяча "
Else
GoTo ti
End If
Case "2":
If Mid$(text, i - 1 , 1 ) <> "1" Then
l = Len(snum)
snum = Left$(snum, l - 2 )
snum = snum & "е тысячи "
Else
GoTo ti
End If
Case "3":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "тысячи "
Else
GoTo ti
End If
Case "4":
If Mid$(text, i - 1 , 1 ) <> "1" Then
snum = snum & "тысячи "
Else
GoTo ti
End If
Case Else
ti: If Mid$(text, i - 2 , 1 ) = "0" And Mid$(text, i - 1 , 1 ) = "0" And s = "0" Then
Else
snum = snum & "тысяч "
End If
End Select
Case 1 :
End Select
End If
i = i + 1
count = count - 1
Loop
' If Mid$(text, 11, 1) <> "1" Then
' Select Case Right$(text, 1)
' Case "1":
' snum = snum & "рубль"
' Case "2":
' snum = snum & "рубля"
' Case "3":
' snum = snum & "рубля"
' Case "4":
'' snum = snum & "рубля"
' Case Else
' snum = snum & "рублей"
' End Select
' Else
' snum = snum & "рублей"
' End If
' snum = snum & " " & kop & " коп."
s = Left$(snum, 1 )
n = Asc(s) - 32
s = Chr$(n)
l = Len(snum) - 1
snum = right$(snum, l)
SummaPropis = s & snum
Exit_SummaPropis:
Exit Function
Err_SummaPropis:
MsgBox Err.Description, , "Функия - SummaPropis"
Resume Exit_SummaPropis
End Function
|
|
|
