Страница 1 из 2

Сумма прописью

Добавлено: 28 фев 2002, 07:30
rager306
Добрый день !

Не подскажите функцию, которая переводила число в сумму прописью с заданной валютой

:)

DoubleToStr(Num : Double, Format : String) : String;

Добавлено: 28 фев 2002, 11:07
m0p3e
Вот с Format и играй. См. приложение 2 (кажется) "Арифметические выражения и функции".

Добавлено: 21 дек 2005, 14:17
levtov
Вывести в Ехсел, а там подключить макрос.
Cells(11, 1) = RUB(saldo, "T")
Function RUB(X As Double, Valut As String) As String 'Разделение на рубли копейки
Dim Sum1 As String
Dim Sum2 As String
Dim nam1 As String
Dim nam2 As String
Dim X1 As Double
Dim X2 As Integer
Select Case Valut
Case "T"
nam1 = " тенге "
nam2 = " тиын "
Case "$"
nam1 = " долларов США "
nam2 = " центов "
End Select
X = Round(X, 2)
X1 = Int(X)
X2 = Round((X - X1) * 100)
If X1 <> 0 Then
Sum1 = RUB_KOP(X1) & nam1
Else
Sum1 = "Ноль " & nam1
End If
Sum2 = Format(X2, "00") & nam2
'Sum3 = Sum1 & Sum2
'k = UCase(Left(Sum3, 1))
'Mid(Sum3, 1) = k
RUB = Format(Sum1 & Sum2, ">")
End Function
'****************************************
Function RUB_KOP(X As Double) ' Возвращает сумму прописью (Допустимый диапазон (0-999,999,999,999))
Dim t(12, 10) As String, t1(10) As String, D(12) As String
Dim Res As String
Dim r As String
Dim k As Integer, i As Integer
If X = 0 Then
RUB_KOP = " ноль "
Else
Res = ""
t(1, 1) = ""
t(1, 2) = "один "
t(1, 3) = "два "
t(1, 4) = "три "
t(1, 5) = "четыре "
t(1, 6) = "пять "
t(1, 7) = "шесть "
t(1, 8) = "семь "
t(1, 9) = "восемь "
t(1, 10) = "девять "

t(2, 1) = ""
t(2, 2) = "десять "
t(2, 3) = "двадцать "
t(2, 4) = "тридцать "
t(2, 5) = "сорок "
t(2, 6) = "пятьдесят "
t(2, 7) = "шестьдесят "
t(2, 8) = "семьдесят "
t(2, 9) = "восемьдесят "
t(2, 10) = "девяносто "

t(3, 1) = ""
t(3, 2) = "сто "
t(3, 3) = "двести "
t(3, 4) = "триста "
t(3, 5) = "четыреста "
t(3, 6) = "пятьсот "
t(3, 7) = "шестьсот "
t(3, 8) = "семьсот "
t(3, 9) = "восемьсот "
t(3, 10) = "девятьсот "

t(4, 1) = ""
t(4, 2) = "одна тысяча "
t(4, 3) = "две тысячи "
t(4, 4) = "три тысячи "
t(4, 5) = "четыре тысячи "
t(4, 6) = "пять тысяч "
t(4, 7) = "шесть тысяч "
t(4, 8) = "семь тысяч "
t(4, 9) = "восемь тысяч "
t(4, 10) = "девять тысяч "

t(5, 1) = ""
t(5, 2) = "десять "
t(5, 3) = "двадцать "
t(5, 4) = "тридцать "
t(5, 5) = "сорок "
t(5, 6) = "пятьдесят "
t(5, 7) = "шестьдесят "
t(5, 8) = "семьдесят "
t(5, 9) = "восемьдесят "
t(5, 10) = "девяносто "

t(6, 1) = ""
t(6, 2) = "сто "
t(6, 3) = "двести "
t(6, 4) = "триста "
t(6, 5) = "четыреста "
t(6, 6) = "пятьсот "
t(6, 7) = "шестьсот "
t(6, 8) = "семьсот "
t(6, 9) = "восемьсот "
t(6, 10) = "девятьсот "

t(7, 1) = ""
t(7, 2) = "один миллион "
t(7, 3) = "два миллиона "
t(7, 4) = "три миллиона "
t(7, 5) = "четыре миллиона "
t(7, 6) = "пять миллионов "
t(7, 7) = "шесть миллионов "
t(7, 8) = "семь миллионов "
t(7, 9) = "восемь миллионов "
t(7, 10) = "девять миллионов "

t(8, 1) = ""
t(8, 2) = "десять "
t(8, 3) = "двадцать "
t(8, 4) = "тридцать "
t(8, 5) = "сорок "
t(8, 6) = "пятьдесят "
t(8, 7) = "шестьдесят "
t(8, 8) = "семьдесят "
t(8, 9) = "восемьдесят "
t(8, 10) = "девяносто "

t(9, 1) = ""
t(9, 2) = "сто "
t(9, 3) = "двести "
t(9, 4) = "триста "
t(9, 5) = "четыреста "
t(9, 6) = "пятьсот "
t(9, 7) = "шестьсот "
t(9, 8) = "семьсот "
t(9, 9) = "восемьсот "
t(9, 10) = "девятьсот "

t(10, 1) = ""
t(10, 2) = "один миллиард "
t(10, 3) = "два миллиарда "
t(10, 4) = "три миллиарда "
t(10, 5) = "четыре миллиарда "
t(10, 6) = "пять миллиардов "
t(10, 7) = "шесть миллиардов "
t(10, 8) = "семь миллиардов "
t(10, 9) = "восемь миллиардов "
t(10, 10) = "девять миллиардов "

t(11, 1) = ""
t(11, 2) = "десять "
t(11, 3) = "двадцать "
t(11, 4) = "тридцать "
t(11, 5) = "сорок "
t(11, 6) = "пятьдесят "
t(11, 7) = "шестьдесят "
t(11, 8) = "семьдесят "
t(11, 9) = "восемьдесят "
t(11, 10) = "девяносто "

t(12, 1) = ""
t(12, 2) = "сто "
t(12, 3) = "двести "
t(12, 4) = "триста "
t(12, 5) = "четыреста "
t(12, 6) = "пятьсот "
t(12, 7) = "шестьсот "
t(12, 8) = "семьсот "
t(12, 9) = "восемьсот "
t(12, 10) = "девятьсот "

t1(1) = "десять "
t1(2) = "одиннадцать "
t1(3) = "двенадцать "
t1(4) = "тринадцать "
t1(5) = "четырнадцать "
t1(6) = "пятнадцать "
t1(7) = "шестнадцать "
t1(8) = "семнадцать "
t1(9) = "восемнадцать "
t1(10) = "девятнадцать "

r = Format(X, "000000000000")

For k = 12 To 1 Step -1
i = Val(Mid(r, 13 - k, 1))
D(k) = t(k, i + 1)
If k = 10 And D(11) = "десять " Then
D(10) = t1(i + 1) + "миллиардов "
D(11) = ""
ElseIf k = 7 And D(8) = "десять " Then
D(7) = t1(i + 1) + "миллионов "
D(8) = ""
ElseIf k = 4 And D(5) = "десять " Then
D(4) = t1(i + 1) + "тысяч "
D(5) = ""
ElseIf k = 4 And D(4) = "" And Not (D(5) = "" And D(6) = "") Then
D(4) = "тысяч "
ElseIf k = 7 And D(7) = "" And Not (D(8) = "" And D(9) = "") Then
D(7) = "миллионов "
ElseIf k = 10 And D(10) = "" And Not (D(11) = "" And D(12) = "") Then
D(10) = "миллиардов "
ElseIf k = 1 And D(2) = "десять " Then
D(1) = t1(i + 1)
D(2) = ""
End If

Next k
RUB_KOP = D(12) + D(11) + D(10) + D(9) + D(8) + D(7) + D(6) + D(5) + D(4) + D(3) + D(2) + D(1)
End If
End Function

Добавлено: 22 дек 2005, 06:13
Алексей
levtov
какие на фиг макросы?

:sad:

doubletostring(0,3.2) = 'Три рубля 20 копеек'

Добавлено: 22 дек 2005, 08:08
levtov
У меня три тенге 20 тиын. А потом для офисных програм пригодится:
ворд, аксес - кто-нибудь спасибо скажет. :???:

Добавлено: 22 дек 2005, 11:21
edward_K
// возвращает сумму прописью и добавляет имя валюты с кодом CVAL
// в нужном падеже (если CVAL = 0, добавляет нац.валюту)
function DoubleToString(cval:comp; i:double) : string;
// возвращает сумму прописью и добавляет имя валюты с кодом CVAL
// в нужном падеже на иностранном языке если CVAL = 0, добавляет нац.валюту
function DoubleToStringInVal(cval:comp; i:double) : string;

Добавлено: 22 дек 2005, 11:23
Алексей
edward_K
2 раза написал для особо одарённых?
:-)

Добавлено: 22 дек 2005, 11:33
edward_K
если повнимательней прочитать, то вторая выводит на иностранном языке( из настроек в класс.валют).

Добавлено: 22 дек 2005, 12:15
Алексей
edward_K
точно :) Приношу извинения :)
Даже не знал что есть такая - не приходилось использовать.

Добавлено: 26 дек 2005, 15:23
Rishat
а что примеры из документации уже не катят?

Примеры

Вывод знака числа:

DoubleToStr(55.55,'3666.88') = '+55.55'
DoubleToStr(-55.55,'3666.88') = '-55.55'
DoubleToStr(55.55,'[|-]3666.88') = '55.55'
DoubleToStr(-55.55,'[|-]3666.88') = '-55.55'
Текстовое представление целой части:

DoubleToStr(5.555,'4КГ 5') =
'пять КГ пятьсот пятьдесят пять тысячных'
DoubleToStr(55.55,'4') = 'пятьдесят пять'
// по умолчанию не округляет, берет только целую часть числа
DoubleToStr(55.55,'\0p4') = 'пятьдесят шесть'
// чтобы округлило до целых, необходимо использовать \0p
DoubleToStr(Round(55.55),'4') = 'пятьдесят шесть'
// или подавать на вход уже округленное число
Текстовое представление дробной части:

DoubleToStr( 0.00, '4 целых 5') = 'ноль целых ноль десятых'
DoubleToStr(5.555,'4КГ 5') =
'пять КГ пятьсот пятьдесят пять тысячных'
DoubleToStr(5.555,'\2p4КГ 5') = 'пять КГ пятьдесят шесть сотых'
// для округления до сотых - надо явно прописать \2p
DoubleToStr(5.555,'\1p4КГ 5') = 'пять КГ шесть десятых'
// для округления до десятых - надо явно прописать \1p
Необязательная (незначимая) цифра целой части:

DoubleToStr(5,'666') ='5'
DoubleToStr(55,'666') ='55'
DoubleToStr(555,'666') = '555'
DoubleToStr(5555,'666') = '***'
DoubleToStr(0.55,'666') = '0'
Обязательная (значимая) цифра целой части:

DoubleToStr(5,'777') = '005'
DoubleToStr(55,'777') = '055'
DoubleToStr(555,'777') = '555'
DoubleToStr(5555,'777') = '***'
Обязательная (значимая) цифра дробной части:

DoubleToStr(5.55,'77.88') = '05.55'
DoubleToStr(5.555,'77.88') = '05.55'
DoubleToStr(5.555,'\2p77.88') = '05.56'
// для округления до N знаков следует воспользоваться \Np
DoubleToStr(5.5,'77.88') = '05.50'
DoubleToStr(5.599,'\2p77.88') = '05.60'
Необязательная (незначимая) цифра дробной части:

DoubleToStr(5.55,'77.99') = '05.55'
DoubleToStr(5.555,'77.99') = '05.55'
DoubleToStr(5.555,'\2p77.99') = '05.56'
DoubleToStr(5.5,'77.99') = '05.5'
DoubleToStr(5.599,'\2p77.99') = '05.6'
Если необходимо, чтобы в дробной части всегда выводилось не менее к примеру 2 знаков, поступаем следующим образом:

DoubleToStr(5.599,'7.8899') = '5.599'
DoubleToStr(5.59,'7.8899') = '5.59'
DoubleToStr(5.9,'7.8899') = '5.90'
Окруление:

DoubleToStr(55.555,'\2p66.99') = '55.56'
// \2p - 2 знака после запятой
DoubleToStr(55.555,'\1p66.99') = '55.6'
// \1p - 1 знак после запятой
DoubleToStr(55.555,'\0p66.99') = '55'
// \0p - округления до целого
DoubleToStr(55.555,'\-1p66.99') = '60'
// \-1p - округления до десятков
Мужской /женский род:

DoubleToStr(22.22,'\m4 РУБЛЯ \f5') =
'двадцать два РУБЛЯ двадцать две сотых'

Добавлено: 30 июл 2009, 11:45
katerpillar
А все то же самое но с заглавной буквы нельзя получить? :)

Добавлено: 30 июл 2009, 11:58
ilshat
а функции upper к строкам нет что ли ?
дергаем первый символ делаем ему upper + начиная со второго до конца строки

Добавлено: 30 июл 2009, 14:27
katerpillar
Да вот что-то не нашел... Просто на UPPER(s) - ругается.

Добавлено: 30 июл 2009, 14:29
edward_K
upcase

Добавлено: 30 июл 2009, 15:17
katerpillar
Thnx.

Правда
UpCase(s[1])+SubStr(s,2,length(s))
не самый удобный способ... :)

Особенно если вместо s написано DoubleToStr(Sum3Itog,'4')

Но все равно спасибо!