ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Запись числа прописью.
6 сообщений из 6, страница 1 из 1
Запись числа прописью.
    #32391093
SergSP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergSP
Гость
Как получить в A97 из 32678,5 р. Тридцать две тысячи шестьсот семьдесят восемь рублей пятьдесят копеек. т.е. вводит человек сумму, а она ему оп-па и прописью пишется.
...
Рейтинг: 0 / 0
28.01.2004, 16:00
| Ответить | Цитировать | Написать  
Запись числа прописью.
    #32391095
Гавриленко Сергей Алексеевич
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гавриленко Сергей Алексеевич
Участник
/topic/55475&hl=%f7%e8%f1%eb%ee+%ef%f0%ee%ef%e8%f1%fc%fe\r
и поск.
...
Рейтинг: 0 / 0
28.01.2004, 16:02
| Ответить | Цитировать | Написать  
Запись числа прописью.
    #32391097
Фотография mv
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
mv
Участник
Вот, пож-ста, тока, правда, на паскале. Я думаю, нетрудно будет на VBA перевести?

//-----------------------------
// Перевод цифры в рубли прописью
// Автор - Малиновский Владимир Владимирович
// Vlad-mal@yandex.ru
function Value_Spelled_Out(Summa : currency;
Penny_For_Penny : boolean = false) : String;
//-----------------------------

type
TOneToNineteen = array [1..19] of string;

const
OneToNineteen : array[1..19] of string =
('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь',
'девять', 'десять', 'одиннадцать', 'двенадцать', 'тринадцать',
'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать',
'восемнадцать', 'девятнадцать');
TenToNinety : array[1..9] of string =
('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят',
'семьдесят', 'восемьдесят', 'девяносто');
OneHunderdToNineHundreds : array [1..9] of string =
('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот',
'семьсот', 'восемьсот', 'девятьсот');
MaleCase : array[1..19] of string =
(' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ',
'ов ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов ');
FemaleCase : array[1..19] of string =
('а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' ', ' ',
' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ');
var
Digits: array[1..15] of integer;
S1 : int64;
S2, NumberOfDigits, ix, k, m : integer;
Rub_Word, Kop_Word : string;
begin
// Summa - Исходная сумма
// не более 999 999 999 999 999.99 руб.
// (...ну, если позволяет компутер...)
// (а так для Currency max = 922 337 203 685 477.5807)
if (Abs(Summa) > 922337203685477.5807) then begin
Result := '********** pубля ';
exit
end;

if Summa < 0 then Result := 'Минус ' else
Result := '';

Summa := Abs(Summa);

S1 := trunc(Summa);
S2 := trunc((Summa-S1)*100);
// s1 - рубли, s2 - копейки

NumberOfDigits := 0;
while s1 > 0 do begin // Разбиваем на десятичные числа
inc(NumberOfDigits);
Digits[NumberOfDigits] := s1 mod 10;
s1 := s1 div 10;
end;

if NumberOfDigits = 0 then
Result := 'Hуль '
else begin
ix := NumberOfDigits;
while ix > 0 do begin
k := ix mod 3; // Разбиваем на десятичные триады
if k = 0 then k := 3;
if (k = 2) and (Digits[ix] = 1) then begin // 10 - 19
dec(ix);
k := 1;
Result := Result + OneToNineteen[10+Digits[ix]] + ' ';
m := 10 + Digits[ix]
end else
if Digits[ix] > 0 then begin
if (ix = 4) and (Digits[ix]=1) then
Result := Result + 'одна '
else if (ix = 4) and (Digits[ix]=2) then
Result := Result + 'две '
else if k = 1 then
Result := Result + OneToNineteen[Digits[ix]] + ' '
else if k = 2 then
Result := Result + TenToNinety[Digits[ix]] + ' '
else if k = 3 then
Result := Result + OneHunderdToNineHundreds[Digits[ix]] + ' ';
m := Digits[ix]
end else
m := 10;

if k = 1 then
if ix = 13 then // триллионов
Result := Result + 'триллион' + MaleCase[m]
else if ix = 10 then // миллиардов
Result := Result + 'миллиард' + MaleCase[m]
else if ix = 7 then // миллионов
Result := Result + 'миллион' + MaleCase[m]
else if (ix = 4) and (Digits[4]+Digits[5]+Digits[6] > 0) // тысяч
then Result := Result + 'тысяч' + FeMaleCase[m];
dec(ix);
end; // while
end; // else

// Пусть будет с 1-й большой буквы
Result[1] := AnsiUpperCase(Result[1])[1];

S1 := trunc(Summa) mod 100;
if S1>20 then
S1 := S1 mod 10;
if S1=1 then Rub_Word:='рубль'
else if (S1=2) or (S1=3) or (S1=4) then Rub_Word := 'рубля'
else Rub_Word := 'рублей';

Result := Result + Rub_Word;

if Penny_For_Penny then begin // До копеек
S1 := S2;
if S1>20 then
S1 := S1 mod 10;
if S1=1 then Kop_Word:='копейка'
else if (S1=2) or (S1=3) or (S1=4) then Kop_Word := 'копейки'
else Kop_Word := 'копеек';
Result := Result + format(' %.2d ',[s2]) + Kop_Word;
end;

end;
...
Рейтинг: 0 / 0
28.01.2004, 16:02
| Ответить | Цитировать | Написать  
Запись числа прописью.
    #32391170
Alexus12
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Alexus12
Участник
ВОТ!
Модераторам - если несложно - просьба добавить в ФАК

Код: 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.
Function Сумма_прописью(ByVal Сумма As Variant, НужныКопейки As Boolean) As String
Static triad( 4 ) As Integer, numb1( 0  To  19 ) As String, numb2( 0  To  9 ) As String, numb3( 0  To  9 ) As String
  
'конвертирование входных данных
If InStr(Сумма, ",") > 0 Then Mid(Сумма, InStr(Сумма, ",")) = "."
If InStr(2, Сумма, "-") > 1 Then Mid(Сумма, InStr(2, Сумма, "-")) = "."
s@ = Val(Сумма)
  
    If s@ = 0 Then
        Сумма_прописью = ""
        Exit Function
    End If
    
    If НужныКопейки Then
    ss@ = Abs(Fix(s@)) 'my fix - чтобы копейки больше  0 , 49  не округляли целый тип triad( 1 ) на единицу больше
    Else
    ss@ = Abs(s@)
    End If
        
    triad( 1 ) = ss@ - Fix(ss@ /  1000 ) *  1000 
    ss@ = Fix(ss@ /  1000 )
    triad( 2 ) = ss@ - Fix(ss@ /  1000 ) *  1000 
    ss@ = Fix(ss@ /  1000 )
    triad( 3 ) = ss@ - Fix(ss@ /  1000 ) *  1000 
    ss@ = Fix(ss@ /  1000 )
    triad( 4 ) = ss@ - Fix(ss@ /  1000 ) *  1000 
    ss@ = Fix(ss@ /  1000 )
    
    numb1( 0 ) =  ""
    numb1(1 ) = "один  "
    numb1(2 ) = "два  "
    numb1(3 ) = "три  "
    numb1(4 ) = "четыре  "
    numb1(5 ) = "пять  "
    numb1(6 ) = "шесть  "
    numb1(7 ) = "семь  "
    numb1(8 ) = "восемь  "
    numb1(9 ) = "девять  "
    numb1(10 ) = "десять  "
    numb1(11 ) = "одиннадцать  "
    numb1(12 ) = "двенадцать  "
    numb1(13 ) = "тринадцать  "
    numb1(14 ) = "четырнадцать  "
    numb1(15 ) = "пятнадцать  "
    numb1(16 ) = "шестнадцать  "
    numb1(17 ) = "семнадцать  "
    numb1(18 ) = "восемнадцать  "
    numb1(19 ) = "девятнадцать  "
    numb2(0 ) = " "
    numb2(1 ) = " "
    numb2(2 ) = "двадцать  "
    numb2(3 ) = "тридцать  "
    numb2(4 ) = "сорок  "
    numb2(5 ) = "пятьдесят  "
    numb2(6 ) = "шестьдесят  "
    numb2(7 ) = "семьдесят  "
    numb2(8 ) = "восемьдесят  "
    numb2(9 ) = "девяносто  "
    numb3(0 ) = " "
    numb3(1 ) = "сто  "
    numb3(2 ) = "двести  "
    numb3(3 ) = "триста  "
    numb3(4 ) = "четыреста  "
    numb3(5 ) = "пятьсот  "
    numb3(6 ) = "шестьсот  "
    numb3(7 ) = "семьсот  "
    numb3(8 ) = "восемьсот  "
    numb3(9 ) = "девятьсот  "
    txt$ = "  "
    If ss@ <> 0  Then
        n% = MsgBox("Сумма выходит за границы формата ", 16 , "Сумма прописью ")
        Сумма_прописью = "  "
        Exit Function
    End If
    For i% = 4  To  1  Step - 1 
        n% =  0 
        If triad(i%) >  0  Then
            n% = Fix(triad(i%) /  100 )
            txt$ = txt$ & numb3(n%)
            n% = Fix((triad(i%) - n% *  100 ) /  10 )
            txt$ = txt$ & numb2(n%)
            If n% <  2  Then
                n% = triad(i%) - (Fix(triad(i%) /  10 ) - n%) *  10 
            Else
                n% = triad(i%) - Fix(triad(i%) /  10 ) *  10 
            End If
            Select Case n%
            Case  1 
                If i% =  2  Then txt$ = txt$ & "одна  " Else txt$ = txt$ & " один  "
            Case 2 
                If i% =  2  Then txt$ = txt$ & "две  " Else txt$ = txt$ & " два  "
            Case Else
                txt$ = txt$ & numb1(n%)
            End Select
            Select Case i%
            Case 2 
                If n% =  0  Or n% >  4  Then
                    txt$ = txt$ + "тысяч  "
                Else
                    If n% = 1  Then txt$ = txt$ + "тысяча  " Else txt$ = txt$ + " тысячи  "
                End If
            Case 3 
                If n% =  0  Or n% >  4  Then
                    txt$ = txt$ + "миллионов  "
                Else
                    If n% = 1  Then txt$ = txt$ + "миллион  " Else txt$ = txt$ + " миллиона  "
                End If
            Case 4 
                If n% =  0  Or n% >  4  Then
                    txt$ = txt$ + "миллиардов  "
                Else
                    If n% = 1  Then txt$ = txt$ + "миллиард  " Else txt$ = txt$ + " миллиарда  "
                End If
            End Select
        End If
    Next i%
    If n% = 0  Or n% >  4  Then
        txt$ = txt$ + "рублей "
    Else
        If n% = 1  Then txt$ = txt$ + "рубль " Else txt$ = txt$ + " рубля "
    End If
    txt$ = UCase$(Left$(txt$, 1 )) & Mid$(txt$,  2 )
    
    
    'my:
    If НужныКопейки = True Then
        If Abs(Fix(s@)) > 0 Then
        'если есть рубли - добавляем к данному тексту
        txt$ = txt$ + "  " + Format$(Abs(CInt((s@ - Fix(s@)) * 100 )), " 00  ") + "  коп. "
        Else
        'рубли=0
        txt$ = Format$(Abs(CInt((s@ - Fix(s@)) * 100)), "00") + " коп."
        End If
    End If
    
    'если отрицательное - взять в скобки
    If s@ < 0  Then txt$ = "( " + txt$ + " )"
    
    Сумма_прописью = txt$
End Function
...
Рейтинг: 0 / 0
28.01.2004, 16:31
| Ответить | Цитировать | Написать  
Запись числа прописью.
    #32391173
SergSP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergSP
Гость
Спасибо тов. Гавриленко Сергей Алексеевич за ссылку, я понял принцип и идею того как надо это делать.
Спасибо тов. mv за такой ответ, но я наверное лучше сам напишу ибо принцип построения мне стал понятен.
...
Рейтинг: 0 / 0
28.01.2004, 16:32
| Ответить | Цитировать | Написать  
Запись числа прописью.
    #32391340
Hibernate
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hibernate
Участник
/topic/65524&hl=#469028\r
на мой взгляд наиболее красивая, компактаня, а главное - функциональная реализация (есть возможность задавать единицу измерения (гривны, рубли, штуки, тугрики - что душа пожелает).
...
Рейтинг: 0 / 0
28.01.2004, 17:31
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Запись числа прописью.
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=45&fpage=1689&tid=1676962]:
 0ms
get settings:
 7ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 47ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 67ms
get tp. blocked users:
 1ms
others: 222ms
total:  377ms
созд. / загр.: 377ms
x
x
Закрыть


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