ReSQL.ru
     
powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Сумма прописью
25 сообщений из 67, страница 1 из 3
  1  все
Сумма прописью
    #32776739
Alex_from_Spb
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex_from_Spb
Гость
Здравствуйте всем. Не подскажет ли кто, есть ли в MS Access 2000/XP встроенная функция (или, уже, может, есть разработанная кем-то) по типу как в 1С, которая позволяет преобразовывать денежные суммы в цифрах в суммы прописью (необходимо для отчета - ТТН в складской программе). В справке и умных книжках по Access ничего на эту тему не нашел, а в форуме копаться просто нет времени. Буду очень благодарен.
...
Рейтинг: 0 / 0
11.11.2004, 10:04
| Ответить | Цитировать | Написать  
Сумма прописью
    #32776807
RVI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
RVI
Участник
Смотри здесь
...
Рейтинг: 0 / 0
11.11.2004, 10:25
| Ответить | Цитировать | Написать  
Сумма прописью
    #32776999
Alex_from_Spb
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alex_from_Spb
Гость
Спасибо огромное, будем разбираться.
...
Рейтинг: 0 / 0
11.11.2004, 11:20
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777172
Terabucks
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Terabucks
Гость
А вот вариант покороче. Написан мною в 1999 :)

Код: plaintext
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.
Public Function NumberToText(Number As Currency) As String
'!Функция орределена на интервале [-922 337 203 685 477,5808;922 337 203 685 477,5807] в силу ограничения
'!накладываемого на аргумент типом данных Currency.
'!Функция расчитана на работу с целочисленными аргументами. В противном случае функция выдает ошибочное значение



On Error GoTo err:
Dim i, j As Integer

    'Dim Number As Currency 'Область определения функции от -922 337 203 685 477,5808 до 922 337 203 685 477,5807
    Dim FirstData( 0  To  9 ) As String
    Dim razr( 1  To  16 ) As String
        'razr1 - единицы
        'razr2 - десятки
        'razr3 - сотни
        'razr4 - тысячи
        'razr5 - десятки тысяч
        'razr6 - сотни тысяч
        'razr7 - миллионы
        'razr8 - десятки мллионов
        'razr9 - сотни миллионов
        'razr10 - миллиарды
        'razr11 - десятки миллиардов
        'razr12 - сотни миллиардов
        'razr13 - трилионы
        'razr14 - десятки трлионов
        'razr15 - сотни трилионов
        
    Dim Text( 1  To  16 ) As String
            FirstData( 1 ) = "один"
            FirstData( 2 ) = "два"
            FirstData( 3 ) = "три"
            FirstData( 4 ) = "четыре"
            FirstData( 5 ) = "пять"
            FirstData( 6 ) = "шесть"
            FirstData( 7 ) = "семь"
            FirstData( 8 ) = "восемь"
            FirstData( 9 ) = "девять"
            FirstData( 0 ) = "ноль"

   'Number = InputBox("Enter number!")
        
        For i =  1  To  15 
                razr(i) = Left(Right(Str$(Fix(Number)), i),  1 )
        Next i
        
        
        
        If Number =  0  Then Text( 1 ) = "ноль рублей"
        
        Select Case razr( 1 )
        Case  1 
            If razr( 2 ) <> "1" Then Text( 1 ) = "один рубль" Else Text( 1 ) = "одинадцать рублей"
        Case  2 
            If razr( 2 ) <> "1" Then Text( 1 ) = "два рубля" Else Text( 1 ) = "двенадцать рублей"
        Case  3 
            If razr( 2 ) <> "1" Then Text( 1 ) = "три рубля" Else Text( 1 ) = "тринадцать рублей"
        Case  4 
            If razr( 2 ) <> "1" Then Text( 1 ) = "четыре рубля" Else Text( 1 ) = "четырнадцать рублей"
        Case  5 
            If razr( 2 ) <> "1" Then Text( 1 ) = "пять рублей" Else Text( 1 ) = "пятнадцать рублей"
        Case  6 
            If razr( 2 ) <> "1" Then Text( 1 ) = "шесть рублей" Else Text( 1 ) = "шестнадцать рублей"
        Case  7 
            If razr( 2 ) <> "1" Then Text( 1 ) = "семь рублей" Else Text( 1 ) = "семнадцать рублей"
        Case  8 
            If razr( 2 ) <> "1" Then Text( 1 ) = "восемь рублей" Else Text( 1 ) = "восемнадцать рублей"
        Case  9 
            If razr( 2 ) <> "1" Then Text( 1 ) = "девять рублей" Else Text( 1 ) = "девятнадцать рублей"
        Case  0 
            If razr( 2 ) <> "1" Then Text( 1 ) = "рублей" Else Text( 1 ) = "десять рублей"
        End Select
        
        
        For i =  2  To  14  Step  3 
        Select Case razr(i)
            Case  1 
                Text(i) = ""
            Case  2 
                Text(i) = "двадцать"
            Case  3 
                Text(i) = "тридцать"
            Case  4 
                Text(i) = "сорок"
            Case  5 
                Text(i) = "пятьдесят"
            Case  6 
                Text(i) = "шестьдесят"
            Case  7 
                Text(i) = "семьдесят"
            Case  8 
                Text(i) = "восемьдесят"
            Case  9 
                Text(i) = "девяносто"
            Case  0 
                Text(i) = ""
        End Select
        Next i
        
        For i =  3  To  15  Step  3 
            Select Case razr(i)
                Case  1 
                    Text(i) = "сто"
                Case  2 
                    Text(i) = "двести"
                Case  3 
                    Text(i) = "триста"
                Case  4 
                    Text(i) = "четыреста"
                Case  5 
                    Text(i) = "пятьсот"
                Case  6 
                    Text(i) = "шестьсот"
                Case  7 
                    Text(i) = "семьсот"
                Case  8 
                    Text(i) = "восемьсот"
                Case  9 
                    Text(i) = "девятьсот"
                Case  0 
                Text(i) = ""
            End Select
        Next i
        
    
        Select Case razr( 4 )
        Case  1 
            If razr( 5 ) <> "1" Then Text( 4 ) = "одна тысяча" Else Text( 4 ) = "одинадцать тысяч"
        Case  2 
            If razr( 5 ) <> "1" Then Text( 4 ) = "две тысячи" Else Text( 4 ) = "двенадцать тысяч"
        Case  3 
            If razr( 5 ) <> "1" Then Text( 4 ) = "три тысячи" Else Text( 4 ) = "тринадцать тысяч"
        Case  4 
            If razr( 5 ) <> "1" Then Text( 4 ) = "четыре тысячи" Else Text( 4 ) = "четырнадцать тысяч"
        Case  5 
            If razr( 5 ) <> "1" Then Text( 4 ) = "пять тысяч" Else Text( 4 ) = "пятнадцать тысяч"
        Case  6 
            If razr( 5 ) <> "1" Then Text( 4 ) = "шесть тысяч" Else Text( 4 ) = "шестнадцать тысяч"
        Case  7 
            If razr( 5 ) <> "1" Then Text( 4 ) = "семь тысяч" Else Text( 4 ) = "семнадцать тысяч"
        Case  8 
            If razr( 5 ) <> "1" Then Text( 4 ) = "восемь тысяч" Else Text( 4 ) = "восемнадцать тысяч"
        Case  9 
            If razr( 5 ) <> "1" Then Text( 4 ) = "девять тысяч" Else Text( 4 ) = "девятнадцать тысяч"
        Case  0 
            If razr( 5 ) <> "1" Then Text( 4 ) = "тысяч" Else Text( 4 ) = "десять тысяч"
            If razr( 5 ) = "0" And razr( 6 ) = "0" Then Text( 4 ) = ""
        End Select
        
                    
        
        Select Case razr( 7 )
        Case  1 
            If razr( 8 ) <> "1" Then Text( 7 ) = "один миллион " Else Text( 7 ) = "одинадцать миллионов"
        Case  2 
            If razr( 8 ) <> "1" Then Text( 7 ) = "два миллиона" Else Text( 7 ) = "двенадцать миллионов"
        Case  3 
            If razr( 8 ) <> "1" Then Text( 7 ) = "три миллиона" Else Text( 7 ) = "тринадцать миллионов"
        Case  4 
            If razr( 8 ) <> "1" Then Text( 7 ) = "четыре миллиона" Else Text( 7 ) = "четырнадцать миллионов"
        Case  5 
            If razr( 8 ) <> "1" Then Text( 7 ) = "пять миллионов" Else Text( 7 ) = "пятнадцать миллионов"
        Case  6 
            If razr( 8 ) <> "1" Then Text( 7 ) = "шесть миллионов" Else Text( 7 ) = "шестнадцать миллионов"
        Case  7 
            If razr( 8 ) <> "1" Then Text( 7 ) = "семь миллионов" Else Text( 7 ) = "семнадцать миллионов"
        Case  8 
            If razr( 8 ) <> "1" Then Text( 7 ) = "восемь миллионов" Else Text( 7 ) = "восемнадцать миллионов"
        Case  9 
            If razr( 8 ) <> "1" Then Text( 7 ) = "девять миллионов" Else Text( 7 ) = "девятнадцать миллионов"
        Case  0 
            If razr( 8 ) <> "1" Then Text( 7 ) = "миллионов" Else Text( 7 ) = "десять миллионов"
            If razr( 8 ) = "0" And razr( 9 ) = "0" Then Text( 7 ) = ""
        End Select
        
        Select Case razr( 10 )
        Case  1 
            If razr( 11 ) <> "1" Then Text( 10 ) = "один миллиард " Else Text( 10 ) = "одинадцать миллиардов"
        Case  2 
            If razr( 11 ) <> "1" Then Text( 10 ) = "два миллиарда" Else Text( 10 ) = "двенадцать миллиардов"
        Case  3 
            If razr( 11 ) <> "1" Then Text( 10 ) = "три миллиарда" Else Text( 10 ) = "тринадцать миллиардов"
        Case  4 
            If razr( 11 ) <> "1" Then Text( 10 ) = "четыре миллиарда" Else Text( 10 ) = "четырнадцать миллиардов"
        Case  5 
            If razr( 11 ) <> "1" Then Text( 10 ) = "пять миллиардов" Else Text( 10 ) = "пятнадцать миллиардов"
        Case  6 
            If razr( 11 ) <> "1" Then Text( 10 ) = "шесть миллиардов" Else Text( 10 ) = "шестнадцать миллиардов"
        Case  7 
            If razr( 11 ) <> "1" Then Text( 10 ) = "семь миллиардов" Else Text( 10 ) = "семнадцать миллиардов"
        Case  8 
            If razr( 11 ) <> "1" Then Text( 10 ) = "восемь миллиардов" Else Text( 10 ) = "восемнадцать миллиардов"
        Case  9 
            If razr( 11 ) <> "1" Then Text( 10 ) = "девять миллиардов" Else Text( 10 ) = "девятнадцать миллиардов"
        Case  0 
            If razr( 11 ) <> "1" Then Text( 10 ) = "миллиардов" Else Text( 10 ) = "десять миллиардов"
            If razr( 11 ) = "0" And razr( 12 ) = "0" Then Text( 10 ) = ""
        End Select
        
        Select Case razr( 13 )
        Case  1 
            If razr( 14 ) <> "1" Then Text( 13 ) = "один трилион " Else Text( 13 ) = "одинадцать трилионов"
        Case  2 
            If razr( 14 ) <> "1" Then Text( 13 ) = "два трилиона" Else Text( 13 ) = "двенадцать трилионов"
        Case  3 
            If razr( 14 ) <> "1" Then Text( 13 ) = "три трилиона" Else Text( 13 ) = "тринадцать трилионов"
        Case  4 
            If razr( 14 ) <> "1" Then Text( 13 ) = "четыре трилиона" Else Text( 13 ) = "четырнадцать трилионов"
        Case  5 
            If razr( 14 ) <> "1" Then Text( 13 ) = "пять трилионов" Else Text( 13 ) = "пятнадцать трилионов"
        Case  6 
            If razr( 14 ) <> "1" Then Text( 13 ) = "шесть трилионов" Else Text( 13 ) = "шестнадцать трилионов"
        Case  7 
            If razr( 14 ) <> "1" Then Text( 13 ) = "семь трилионов" Else Text( 13 ) = "семнадцать трилионов"
        Case  8 
            If razr( 14 ) <> "1" Then Text( 13 ) = "восемь трилионов" Else Text( 13 ) = "восемнадцать трилионов"
        Case  9 
            If razr( 14 ) <> "1" Then Text( 13 ) = "девять трилионов" Else Text( 13 ) = "девятнадцать трилионов"
        Case  0 
            If razr( 14 ) <> "1" Then Text( 13 ) = "трилионов" Else Text( 13 ) = "десять трилионов"
            If razr( 14 ) = "0" And razr( 15 ) = "0" Then Text( 13 ) = ""
        End Select
                
        For i =  15  To  1  Step - 1 
            If Text(i) <> "" Then Text( 16 ) = Text( 16 ) + Text(i) + " "
        Next i
    NumberToText = Text( 16 )
        'MsgBox Str(Number) + " = " + Text(16)

Exit Function
err:
MsgBox "Don't worry, error!"
End Function
...
Рейтинг: 0 / 0
11.11.2004, 12:02
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777251
еще короче, и функциональней
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
еще короче, и функциональней
Гость
Код: plaintext
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.
Public Function StrValue(ByVal Summ As Double, Optional TypeVal As Byte =  1 ) As String
  Dim recs999(- 3  To  5 ) As Variant
  ' массив описаний числительных:
  ' 1-й аргумент - род: "1" - мужской, "2" - женский, "3" - средний
  ' 5-й аргумент - наименование дробной части, если <>"", то выводится
  ' 6-й аргумент - "1" - добавлять нулевое значение
  recs999(- 3 ) = Array("1", "миллиард", "миллиарда", "миллиардов", "", "")
  recs999(- 2 ) = Array("1", "миллион", "миллиона", "миллионов", "", "")
  recs999(- 1 ) = Array("2", "тысяча", "тысячи", "тысяч", "", "")
  recs999( 0 ) = Array("1", "доллар", "доллара", "долларов", "цент(а,ов)", "1")
  recs999( 1 ) = Array("1", "рубль", "рубля", "рублей", "коп.", "1")
  recs999( 2 ) = Array("2", "штука", "штуки", "штук", "", "1")
  recs999( 3 ) = Array("3", "наименование", "наименования", "наименований", "", "1")
  recs999( 4 ) = Array("1", "", "", "", "", "1")
  recs999( 5 ) = Array("1", "месяц", "месяца", "месяцев", "", "1")
      
  If Summ <  0  Then StrValue = "Минус "
  Summ = Abs(Summ)
  StrValue = StrValue & StrValue999(Summ /  1000000000 , recs999(- 3 )) ' миллиарды
  StrValue = StrValue & StrValue999(Summ /  1000000 , recs999(- 2 )) ' миллионы
  StrValue = StrValue & StrValue999(Summ /  1000 , recs999(- 1 )) ' тысячи
  StrValue = StrValue & StrValue999(Summ, recs999(TypeVal))
  
  StrValue = StrConv(Left(StrValue,  1 ), vbUpperCase) & Trim(Mid(StrValue,  2 ))
End Function

Private Function StrValue999(Summ As Double, TypeVal) As String
  If TypeVal( 5 ) = "1" And Fix(Summ) =  0  Then
    StrValue999 = "ноль " & TypeVal( 3 ) & " "
  Else
    StrValue999 = "" & Choose(Fix(Summ - Fix(Summ /  1000 ) *  1000 ) \  100 , _
      "сто ", "двести ", "триста ", "четыреста ", "пятсот ", _
      "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
    If Fix(Summ - Fix(Summ /  100 ) *  100 ) >=  11  And Fix(Summ - Fix(Summ /  100 ) *  100 ) <=  19  Then
      StrValue999 = StrValue999 & Choose(Fix(Summ - Fix(Summ /  100 ) *  100 ) -  10 , _
        "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", _
        "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать") & " " & TypeVal( 3 ) & " "
    Else
      StrValue999 = StrValue999 & Choose((Fix(Summ - Fix(Summ /  100 ) *  100 )) \  10 , _
        "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", _
        "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
      StrValue999 = StrValue999 & Choose(Fix(Summ - Fix(Summ /  10 ) *  10 ), _
        Choose(TypeVal( 0 ), "один ", "одна ", "одно "), _
        Choose(TypeVal( 0 ), "два ", "две ", "два "), _
        "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
      Select Case Fix(Summ - Fix(Summ /  10 ) *  10 )
        Case  1 : StrValue999 = StrValue999 & TypeVal( 1 ) & " "
        Case  2  To  4 : StrValue999 = StrValue999 & TypeVal( 2 ) & " "
        Case Else:
          If Fix((Summ /  1000  - Fix(Summ /  1000 )) *  1000 ) <>  0  Or TypeVal( 5 ) = "1" Then _
            StrValue999 = StrValue999 & TypeVal( 3 ) & " "
      End Select
    End If
  End If
  If TypeVal( 4 ) <> "" Then StrValue999 = StrValue999 & Format((Summ - Fix(Summ)) *  100 , "00") & " " & TypeVal( 4 )
End Function
...
Рейтинг: 0 / 0
11.11.2004, 12:24
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777317
Terabucks
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Terabucks
Гость
Хм. Ну да. Задумка более сильная, учитывая разные наименования единиц измерения и копейки, но:

Код: plaintext
MsgBox StrValue( 7984166000333 #,  1 )

Вместо семь трилионов девятьсот восемьдесят четыре миллиарда сто шестьдесят шесть миллионов триста тридцать три рубля

Ваш вариант выдал Девятьсот восемьдесят четыре миллиарда сто шестьдесят шесть миллионов тысяч триста тридцать три рубля 00 коп., куда-то дев трилионы. Хотя трилионы конечно редко нужны. Но вот слово выделенное жирным совершенно "не в кассу".

Хотя код конечно короче. Я не глумлюсь, а лишь обращаю Ваше внимание на баг.
...
Рейтинг: 0 / 0
11.11.2004, 12:45
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777667
он же
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
он же
Участник
и вправду. Спасибо. Поправил у себя и тут.
...
Рейтинг: 0 / 0
11.11.2004, 14:56
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777682
он же
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
он же
Участник
а с триллионными суммами еще не встречался. Впрочем, чтобы их добавить, надо дописать две строчки:

Код: plaintext
1.
2.
3.
4.
Dim recs999(- 4  To  5 ) As Variant
...
  recs999(- 4 ) = Array("1", "триллион", "триллиона", "триллионов", "", "")
...
  StrValue = StrValue & StrValue999(Summ /  1000000000000 , recs999(- 4 )) ' триллионы

и проверить - возможно, вместо double надо будет использовать currency
...
Рейтинг: 0 / 0
11.11.2004, 15:01
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777689
ззы
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ззы
Гость
ззы. Кстати, этот вариант отнюдь не самый быстрый, он только довольно короткий и простой. А у Андрея Митина вариант более функциональный.
...
Рейтинг: 0 / 0
11.11.2004, 15:03
| Ответить | Цитировать | Написать  
Сумма прописью
    #32777861
Terabucks
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Terabucks
Гость
Согласен. Ваш вариант изящней. :)
...
Рейтинг: 0 / 0
11.11.2004, 16:03
| Ответить | Цитировать | Написать  
Сумма прописью
    #32778086
Фотография Shurgenz
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shurgenz
Участник
хм... а currency, не возможно, а надо - точно... с округлением и потерями копеек проблем не будет
...
Рейтинг: 0 / 0
11.11.2004, 17:19
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Сумма прописью
    #36216997
Dasyp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dasyp
Гость
StrValue999 = "" & Choose(Fix(Summ - Fix(Summ / 1000) * 1000) \ 100, _
"сто ", "двести ", "триста ", "четыреста ", "пятсот ", _
"шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")

"пятсот " - надо с мягким знаком сделать. "пятьсот"
...
Рейтинг: 0 / 0
25.09.2009, 12:47
| Ответить | Цитировать | Написать  
Сумма прописью
    #36218305
rok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
rok
Участник
Рекомендую!
Код: plaintext
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.
Public Function TextSum(numSum As Variant) As String
w$ = Round(numSum,  2 ) 'Входное число - tekst tipа "123.45",защита
'"от дурака" не сделана
'выделение рублей в записи числа и удаление левых пробелов
rubli$ = LTrim$(Left$(Str(Val(w$) *  100 ), _
Len(Str(Val(w$) *  100 )) -  2 ))
cop$ = RTrim$(Right$(Str(CDbl(w$) *  100 ),  2 )) 'выделение дробной части
'числа и удаление правых пробелов

Do While Len(rubli$) <  9 
rubli$ = "0" & rubli$
Loop
res$ = ""
For i% =  1  To  3 
trojka$ = Mid$(rubli$,  3  * i% -  2 ,  3 )
Call Num3(trojka$, i%) ' Вызов функции формирования gotovoй тройки,
'tipа "123 тысячи"
res$ = res$ & trojka$ ' Накопление таких троек
Next i%
'res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) - 1) 'Запись
'первой буквы res$ в верхнем регистре

c$ = " коп." ' Блок добавления копеек
If (Right$(cop$,  1 ) = "1" And Left$(cop$,  1 ) <> "1") Then c$ = _
" коп."
If ((Right$(cop$,  1 ) = "2" Or Right$(cop$,  1 ) = "3" Or _
Right$(cop$,  1 ) = "4") And Left$(cop$,  1 ) <> "1") Then _
c$ = " коп."
If Left(res$,  1 ) <> "Р" Then res$ = res$ & cop$ & c$ Else _
res$ = cop$ & c$

TextSum = res$ ' Выход tekstа
End Function


Public Function Num3(trojka$, i%)
Dim sl$( 1  To  3 ,  0  To  3 )
sl$( 1 ,  1 ) = "миллион "
sl$( 2 ,  1 ) = "тысяча "
sl$( 3 ,  1 ) = "рубль "
'-
sl$( 1 ,  2 ) = "миллиона "
sl$( 2 ,  2 ) = "тысячи "
sl$( 3 ,  2 ) = "рубля "
'-
sl$( 1 ,  3 ) = "миллионов "
sl$( 2 ,  3 ) = "тысяч "
sl$( 3 ,  3 ) = "рублей "
sl$( 3 ,  0 ) = "рублей "
'-
ed$ = Right$(trojka$,  1 )
des$ = Mid$(trojka$,  2 ,  1 )
sot$ = Left$(trojka$,  1 )
'-
If ed$ = "0" Then r3$ = ""
If ed$ = "1" Then If i% =  2  Then r3$ = "одна " Else r3$ = "один "
If ed$ = "2" Then If i% =  2  Then r3$ = "две " Else r3$ = "два "
If ed$ = "3" Then r3$ = "три "
If ed$ = "4" Then r3$ = "четыре "
If ed$ = "5" Then r3$ = "пять "
If ed$ = "6" Then r3$ = "шесть "
If ed$ = "7" Then r3$ = "семь "
If ed$ = "8" Then r3$ = "восемь "
If ed$ = "9" Then r3$ = "девять "
'-
If des$ = "0" Then r2$ = ""
s$ = des$ & ed$
If s$ = "10" Then r3$ = "десять "
If s$ = "11" Then r3$ = "одиннадцать "
If s$ = "12" Then r3$ = "двенадцать "
If s$ = "13" Then r3$ = "тринадцать "
If s$ = "14" Then r3$ = "четырнадцать "
If s$ = "15" Then r3$ = "пятнадцать "
If s$ = "16" Then r3$ = "шестнадцать "
If s$ = "17" Then r3$ = "семнадцать "
If s$ = "18" Then r3$ = "восемнадцать "
If s$ = "19" Then r3$ = "девятнадцать "
'-
If des$ = "2" Then r2$ = "двадцать "
If des$ = "3" Then r2$ = "тридцать "
If des$ = "4" Then r2$ = "сорок "
If des$ = "5" Then r2$ = "пятьдесят "
If des$ = "6" Then r2$ = "шестьдесят "
If des$ = "7" Then r2$ = "семьдесят "
If des$ = "8" Then r2$ = "восемьдесят "
If des$ = "9" Then r2$ = "девяносто "
'-
If sot$ = "0" Then r1$ = ""
If sot$ = "1" Then r1$ = "сто "
If sot$ = "2" Then r1$ = "двести "
If sot$ = "3" Then r1$ = "триста "
If sot$ = "4" Then r1$ = "четыреста "
If sot$ = "5" Then r1$ = "пятьсот "
If sot$ = "6" Then r1$ = "шестьсот "
If sot$ = "7" Then r1$ = "семьсот "
If sot$ = "8" Then r1$ = "восемьсот "
If sot$ = "9" Then r1$ = "девятьсот "
'-
If trojka$ <> "000" Then j% = (- 1 ) * CInt(ed$ = "1" And des$ <> "1") _
+ (- 2 ) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1")
If j% =  0  And trojka$ <> "000" Then j% =  3 
trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и
'слова,например-"123 тысячи"
End Function
...
Рейтинг: 0 / 0
25.09.2009, 19:57
| Ответить | Цитировать | Написать  
Сумма прописью
    #36218395
Guest33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Guest33
Участник
Для коллекции
Код: plaintext
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.
Public V7 As Object

Function ConnectTo1C() As Boolean
Dim path7 As String
On Error Resume Next
ConnectTo1C = False

path7 = "/DD:\1CData\Base2006"
path7 = path7 & " /NБухгалтер" ' User
path7 = path7 & " /P" ' Пароль

Set V7 = CreateObject("V77M.Application")
ConnectTo1C = V7.Initialize(V7.rmtrade, path7, "NO_SPLASH_SHOW")
End Function

Public Sub Disconnect1C()
  If Not V7 Is Nothing Then
    V7.ExecuteBatch ("ЗавершитьРаботуСистемы((0);")
    Set V7 = Nothing
  End If
End Sub

Public Function SumToText(MSum As Double) As String
If V7 Is Nothing Then
  If Not ConnectTo1C Then
    MsgBox "Связь с 1Ц не установлена!", vbCritical, "УФО+"
    Set V7 = Nothing
    SumToText = ""
    Exit Function
  End If
End If

'Рубли
V7.ExecuteBatch ("Пропись()")

'Доллары
'V7.ExecuteBatch ("Пропись(""USD.SPL"")")

SumToText = V7.EvalExpr("Формат(" & MSum & ", ""ЧПДС"")")

If Not V7 Is Nothing Then
  Disconnect1C
End If

End Function
...
Рейтинг: 0 / 0
25.09.2009, 21:14
| Ответить | Цитировать | Написать  
Сумма прописью
    #36218609
Nebo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Nebo
Участник
Ещё одна сумма прописью, которую я использую, работает нормально:

Смотреть здесь: http://kuprava.narod.ru/rudn.htm

и здесь с исправленной ошибкой: http://kuprava.narod.ru/omiss_ex.htm
...
Рейтинг: 0 / 0
26.09.2009, 02:56
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Сумма прописью
    #36889763
Agaralex
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Agaralex
Гость
Можете ли подскажать почему у меня не работает ни один из скриптов... То ругается на "Имя?", то ругается на отстутствие необходимых библиотек при выполнении команд, например Str
...
Рейтинг: 0 / 0
08.10.2010, 15:50
| Ответить | Цитировать | Написать  
Сумма прописью
    #36889842
Фотография mds_world
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
mds_world
Участник
AgaralexМожете ли подскажать почему у меня не работает ни один из скриптов... То ругается на "Имя?", то ругается на отстутствие необходимых библиотек при выполнении команд, например Str
Библиотеки. Наверняка. Зайдите в любом модуле в редактор ВБА. Далее меню-Tools-References. Ищите там среди библиотек с галочкой слово Missing. Снимите галочку с этой библиотеки
...
Рейтинг: 0 / 0
08.10.2010, 16:17
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Сумма прописью
    #37763525
ArtemKru
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ArtemKru
Гость
rokРекомендую!
Код: vbnet
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.
Public Function TextSum(numSum As Variant) As String
w$ = Round(numSum, 2) 'Входное число - tekst tipа "123.45",защита
'"от дурака" не сделана
'выделение рублей в записи числа и удаление левых пробелов
rubli$ = LTrim$(Left$(Str(Val(w$) * 100), _
Len(Str(Val(w$) * 100)) - 2))
cop$ = RTrim$(Right$(Str(CDbl(w$) * 100), 2)) 'выделение дробной части
'числа и удаление правых пробелов

Do While Len(rubli$) < 9
rubli$ = "0" & rubli$
Loop
res$ = ""
For i% = 1 To 3
trojka$ = Mid$(rubli$, 3 * i% - 2, 3)
Call Num3(trojka$, i%) ' Вызов функции формирования gotovoй тройки,
'tipа "123 тысячи"
res$ = res$ & trojka$ ' Накопление таких троек
Next i%
'res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) - 1) 'Запись
'первой буквы res$ в верхнем регистре

c$ = " коп." ' Блок добавления копеек
If (Right$(cop$, 1) = "1" And Left$(cop$, 1) <> "1") Then c$ = _
" коп."
If ((Right$(cop$, 1) = "2" Or Right$(cop$, 1) = "3" Or _
Right$(cop$, 1) = "4") And Left$(cop$, 1) <> "1") Then _
c$ = " коп."
If Left(res$, 1) <> "Р" Then res$ = res$ & cop$ & c$ Else _
res$ = cop$ & c$

TextSum = res$ ' Выход tekstа
End Function


Public Function Num3(trojka$, i%)
Dim sl$(1 To 3, 0 To 3)
sl$(1, 1) = "миллион "
sl$(2, 1) = "тысяча "
sl$(3, 1) = "рубль "
'-
sl$(1, 2) = "миллиона "
sl$(2, 2) = "тысячи "
sl$(3, 2) = "рубля "
'-
sl$(1, 3) = "миллионов "
sl$(2, 3) = "тысяч "
sl$(3, 3) = "рублей "
sl$(3, 0) = "рублей "
'-
ed$ = Right$(trojka$, 1)
des$ = Mid$(trojka$, 2, 1)
sot$ = Left$(trojka$, 1)
'-
If ed$ = "0" Then r3$ = ""
If ed$ = "1" Then If i% = 2 Then r3$ = "одна " Else r3$ = "один "
If ed$ = "2" Then If i% = 2 Then r3$ = "две " Else r3$ = "два "
If ed$ = "3" Then r3$ = "три "
If ed$ = "4" Then r3$ = "четыре "
If ed$ = "5" Then r3$ = "пять "
If ed$ = "6" Then r3$ = "шесть "
If ed$ = "7" Then r3$ = "семь "
If ed$ = "8" Then r3$ = "восемь "
If ed$ = "9" Then r3$ = "девять "
'-
If des$ = "0" Then r2$ = ""
s$ = des$ & ed$
If s$ = "10" Then r3$ = "десять "
If s$ = "11" Then r3$ = "одиннадцать "
If s$ = "12" Then r3$ = "двенадцать "
If s$ = "13" Then r3$ = "тринадцать "
If s$ = "14" Then r3$ = "четырнадцать "
If s$ = "15" Then r3$ = "пятнадцать "
If s$ = "16" Then r3$ = "шестнадцать "
If s$ = "17" Then r3$ = "семнадцать "
If s$ = "18" Then r3$ = "восемнадцать "
If s$ = "19" Then r3$ = "девятнадцать "
'-
If des$ = "2" Then r2$ = "двадцать "
If des$ = "3" Then r2$ = "тридцать "
If des$ = "4" Then r2$ = "сорок "
If des$ = "5" Then r2$ = "пятьдесят "
If des$ = "6" Then r2$ = "шестьдесят "
If des$ = "7" Then r2$ = "семьдесят "
If des$ = "8" Then r2$ = "восемьдесят "
If des$ = "9" Then r2$ = "девяносто "
'-
If sot$ = "0" Then r1$ = ""
If sot$ = "1" Then r1$ = "сто "
If sot$ = "2" Then r1$ = "двести "
If sot$ = "3" Then r1$ = "триста "
If sot$ = "4" Then r1$ = "четыреста "
If sot$ = "5" Then r1$ = "пятьсот "
If sot$ = "6" Then r1$ = "шестьсот "
If sot$ = "7" Then r1$ = "семьсот "
If sot$ = "8" Then r1$ = "восемьсот "
If sot$ = "9" Then r1$ = "девятьсот "
'-
If trojka$ <> "000" Then j% = (-1) * CInt(ed$ = "1" And des$ <> "1") _
+ (-2) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1")
If j% = 0 And trojka$ <> "000" Then j% = 3
trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и
'слова,например-"123 тысячи"
End Function



Знающие люди подскажите как пользоваться этим макросом
...
Рейтинг: 0 / 0
20.04.2012, 16:39
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763554
ТвердолобыйЛамер
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ТвердолобыйЛамер
Участник
ArtemKruЗнающие люди подскажите как пользоваться этим макросом
Что совсем ни ни?
...
Рейтинг: 0 / 0
20.04.2012, 16:47
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763556
alvk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alvk
Участник
ArtemKru,

Кем пользоваться??
...
Рейтинг: 0 / 0
20.04.2012, 16:48
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763559
ТвердолобыйЛамер
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ТвердолобыйЛамер
Участник
alvkКем пользоваться??
ЧЕМ
...
Рейтинг: 0 / 0
20.04.2012, 16:48
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763594
alvk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alvk
Участник
ТвердолобыйЛамер,

- Абрамыч, вы в партию вступили?
- Ой, где?
...
Рейтинг: 0 / 0
20.04.2012, 16:59
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763705
212121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
212121
Гость
ArtemKrurokРекомендую!
Код: vbnet
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.
Public Function TextSum(numSum As Variant) As String
w$ = Round(numSum, 2) 'Входное число - tekst tipа "123.45",защита
'"от дурака" не сделана
'выделение рублей в записи числа и удаление левых пробелов
rubli$ = LTrim$(Left$(Str(Val(w$) * 100), _
Len(Str(Val(w$) * 100)) - 2))
cop$ = RTrim$(Right$(Str(CDbl(w$) * 100), 2)) 'выделение дробной части
'числа и удаление правых пробелов

Do While Len(rubli$) < 9
rubli$ = "0" & rubli$
Loop
res$ = ""
For i% = 1 To 3
trojka$ = Mid$(rubli$, 3 * i% - 2, 3)
Call Num3(trojka$, i%) ' Вызов функции формирования gotovoй тройки,
'tipа "123 тысячи"
res$ = res$ & trojka$ ' Накопление таких троек
Next i%
'res$ = UCase$(Left$(res$, 1)) & Right$(res$, Len(res$) - 1) 'Запись
'первой буквы res$ в верхнем регистре

c$ = " коп." ' Блок добавления копеек
If (Right$(cop$, 1) = "1" And Left$(cop$, 1) <> "1") Then c$ = _
" коп."
If ((Right$(cop$, 1) = "2" Or Right$(cop$, 1) = "3" Or _
Right$(cop$, 1) = "4") And Left$(cop$, 1) <> "1") Then _
c$ = " коп."
If Left(res$, 1) <> "Р" Then res$ = res$ & cop$ & c$ Else _
res$ = cop$ & c$

TextSum = res$ ' Выход tekstа
End Function


Public Function Num3(trojka$, i%)
Dim sl$(1 To 3, 0 To 3)
sl$(1, 1) = "миллион "
sl$(2, 1) = "тысяча "
sl$(3, 1) = "рубль "
'-
sl$(1, 2) = "миллиона "
sl$(2, 2) = "тысячи "
sl$(3, 2) = "рубля "
'-
sl$(1, 3) = "миллионов "
sl$(2, 3) = "тысяч "
sl$(3, 3) = "рублей "
sl$(3, 0) = "рублей "
'-
ed$ = Right$(trojka$, 1)
des$ = Mid$(trojka$, 2, 1)
sot$ = Left$(trojka$, 1)
'-
If ed$ = "0" Then r3$ = ""
If ed$ = "1" Then If i% = 2 Then r3$ = "одна " Else r3$ = "один "
If ed$ = "2" Then If i% = 2 Then r3$ = "две " Else r3$ = "два "
If ed$ = "3" Then r3$ = "три "
If ed$ = "4" Then r3$ = "четыре "
If ed$ = "5" Then r3$ = "пять "
If ed$ = "6" Then r3$ = "шесть "
If ed$ = "7" Then r3$ = "семь "
If ed$ = "8" Then r3$ = "восемь "
If ed$ = "9" Then r3$ = "девять "
'-
If des$ = "0" Then r2$ = ""
s$ = des$ & ed$
If s$ = "10" Then r3$ = "десять "
If s$ = "11" Then r3$ = "одиннадцать "
If s$ = "12" Then r3$ = "двенадцать "
If s$ = "13" Then r3$ = "тринадцать "
If s$ = "14" Then r3$ = "четырнадцать "
If s$ = "15" Then r3$ = "пятнадцать "
If s$ = "16" Then r3$ = "шестнадцать "
If s$ = "17" Then r3$ = "семнадцать "
If s$ = "18" Then r3$ = "восемнадцать "
If s$ = "19" Then r3$ = "девятнадцать "
'-
If des$ = "2" Then r2$ = "двадцать "
If des$ = "3" Then r2$ = "тридцать "
If des$ = "4" Then r2$ = "сорок "
If des$ = "5" Then r2$ = "пятьдесят "
If des$ = "6" Then r2$ = "шестьдесят "
If des$ = "7" Then r2$ = "семьдесят "
If des$ = "8" Then r2$ = "восемьдесят "
If des$ = "9" Then r2$ = "девяносто "
'-
If sot$ = "0" Then r1$ = ""
If sot$ = "1" Then r1$ = "сто "
If sot$ = "2" Then r1$ = "двести "
If sot$ = "3" Then r1$ = "триста "
If sot$ = "4" Then r1$ = "четыреста "
If sot$ = "5" Then r1$ = "пятьсот "
If sot$ = "6" Then r1$ = "шестьсот "
If sot$ = "7" Then r1$ = "семьсот "
If sot$ = "8" Then r1$ = "восемьсот "
If sot$ = "9" Then r1$ = "девятьсот "
'-
If trojka$ <> "000" Then j% = (-1) * CInt(ed$ = "1" And des$ <> "1") _
+ (-2) * CInt((ed$ = "2" Or ed$ = "3" Or ed$ = "4") And des$ <> "1")
If j% = 0 And trojka$ <> "000" Then j% = 3
trojka$ = r1$ & r2$ & r3$ & sl$(i%, j%) 'формирование тройки цифр и
'слова,например-"123 тысячи"
End Function



Знающие люди подскажите как пользоваться этим макросом
копируешь эту функцию в какой-нить модуль (закладка модули), затем
там где надо вызываешь её (типа:

Код: sql
1.
2.
3.
4.
Sub test1()
  sss = TextSum(12345.67)
  Debug.Print sss
End Sub
...
Рейтинг: 0 / 0
20.04.2012, 17:45
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763719
Фотография mds_world
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
mds_world
Участник
Видимо, функция требуется в форме или отчете? Тогда в том поле, где должна быть сумма прописью, в ControlSource (свойство Данные поля) пишете
=TextSum([ЗдесьИмяПоляСуммы])
...
Рейтинг: 0 / 0
20.04.2012, 17:50
| Ответить | Цитировать | Написать  
Сумма прописью
    #37763727
Фотография mds_world
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
mds_world
Участник
Ну и да, как уже сказано, функция должна быть в обычном модуле. Или в модуле той формы/отчета, в котором она вызывается.
...
Рейтинг: 0 / 0
20.04.2012, 17:52
| Ответить | Цитировать | Написать  
25 сообщений из 67, страница 1 из 3
  1  все
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Сумма прописью
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=45&fpage=30&tid=1610599]:
 0ms
get settings:
 8ms
get forum list:
 16ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 30ms
get topic data:
 72ms
get forum data:
 3ms
get page messages:
 76ms
get tp. blocked users:
 1ms
others: 311ms
total:  523ms
созд. / загр.: 523ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]