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

[morpheus]

Вопрос
Очень часто появляеться необходимость написать некоторые числа прописью (243=двести-сорок-три), как это зделать?

Ответ

Здравствуйте, господа! Столкнулся с проблемой: надо было сумму написать прописью. На нашем форуме ничего не нашёл. Переделал код, который взял с SQL.ru ну и примочек всяких добавил. Возможно кому-то пригодится:

[codebox]Dim NumEd (1 To 19) As String
Dim NumEd1(1 To 2) As String
Dim NumDec (2 To 9) As String
Dim NumSot (1 To 9) As String
Dim Xlion0 (1 To 3) As String
Dim Xlion1 (1 To 3) As String
Dim Xlion2 (1 To 3) As String

Class Money
Public Function MoneyToWord(Money As Double, valut As String, includekops As Boolean) As String
Select Case valut
Case "RUR":
NumArrayInitRUR
Case Else
valut = "RUR"
NumArrayInitRUR
End Select

Dim Money3 As Integer, MoneyI As Integer, MoneyK As Integer, Digit As Integer, LastDigit As Integer, T As Integer

Dim Sto As String, Kop As String, Result As String

MoneyI = Money

MoneyK = Round((Money - MoneyI) * 100, 0)

T = 0

While MoneyI > 0

Money3 = MoneyI Mod 1000

MoneyI = Int(MoneyI / 1000)

Sto = ""

If (Money3 Mod 100) < 20 Then

LastDigit = (Money3 Mod 20)

If LastDigit > 0 Then

If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If

Money3 = Int(Money3 /100)

Else

LastDigit = Money3 Mod 10

If LastDigit > 0 Then

If (T = 1) And (LastDigit =1 Or LastDigit =2) Then
Sto = NumEd1(LastDigit)
Else
Sto = NumEd(LastDigit)
End If
End If

Money3 = Int(Money3 / 10)

Digit = Money3 Mod 10

If Digit > 0 Then
Sto = NumDec(Digit) + Sto
End If

Money3 = Int(Money3 / 10)

End If

If Money3 > 0 Then
Sto = NumSot(Money3) + Sto
End If

If T > 0 Then

If LastDigit = 1 Then
Sto = Sto + Xlion1(T)
Else
If (LastDigit >= 2 And LastDigit<= 4) Then
Sto = Sto + Xlion2(T)
Else
Sto = Sto + Xlion0(T)
End If
End If
End If
T = T + 1

Result = Sto + Result
Wend

Kop =Cstr(MoneyK Mod 10)

MoneyK = MoneyK / 10

Kop = Cstr(MoneyK) + Kop
Select Case valut
Case "RUR":
If includekops Then
Result = Result + "руб. " + Kop + " коп."
Else
Result =Result + "руб. "
End If
End Select
MoneyToWord = result
End Function

Private Sub NumArrayInitRUR

NumEd(1) = "один "
NumEd(2) = "два "
NumEd(3) = "три "
NumEd(4) = "четыре "
NumEd(5) = "пять "
NumEd(6) = "шесть "
NumEd(7) = "семь "
NumEd(8) = "восемь "
NumEd(9) = "девять "
NumEd(10) = "десять "
NumEd(11) = "одиннадцать "
NumEd(12) = "двенадцать "
NumEd(13) = "тринадцать "
NumEd(14) = "четырнадцать "
NumEd(15) = "пятнадцать "
NumEd(16) = "шестадцать "
NumEd(17) = "семнадцать "
NumEd(18) = "восемнадцать "
NumEd(19) = "девятнадцать "

NumEd1(1) = "одна "
NumEd1(2) = "две "

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

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

XLion0(1) = "тысяч "
XLion0(2) = "миллионов "
XLion0(3) = "миллиардов "

XLion1(1) = "тысяча "
XLion1(2) = "миллион "
XLion1(3) = "миллиард "

XLion2(1) = "тысячи "
XLion2(2) = "миллиона "
XLion2(3) = "миллиарда"
End Sub
End Class[/codebox]

Комментарий

Работает с рублями. Если написать процедуру инит для др валюты то будет с другой валютой работать. Прошу известить если найдете косячки или просто чего-то доработаете.

Параметр valut - наименование валюты по международной номенклатуре. includekops - добавлять или нет копейки к сумме.

Автор
link removed

 

[K-Fire]

Убийственный код

Dim Money3 As Integer, MoneyI As Integer, MoneyK As Integer, Digit As Integer, LastDigit As Integer, T As Integer

Dim Sto As String, Kop As String, Result As String

MoneyI = Money

Передавать параметр как Double и потом его приводить к Integer-у это сильно



P.S. И вообще он выдает неверные результаты для некоторых цифр. Править такой запутанный код без единого комментария - бессмысленно.

 

[morpheus]

<!--QuoteBegin-K-Fire+9:01:2007, 16:27 -->
<span class="vbquote">(K-Fire @ 9:01:2007, 16:27 )</span><!--QuoteEBegin-->Передавать параметр как Double и потом его приводить к Integer-у это сильно

[snapback]52627" rel="nofollow" target="_blank[/snapback]​

[/quote]
Хм... незаметил... будем править

 

[Azrael]

Вот код в виде агента (писал уже давно, счас уже не все помню... оставил старые комментарии), не слишком оптимально, но все же использую по сей день :

[codebox]Sub Initialize
' Сумма прописью

' переменные среды:
' "сумма" - число, прописную форму которого требуется получить
' "сумма-вид" - тип числа: 1) "цена" (руб.коп.); 2) "число"; 3) "целое число"
' "сумма-имя" - имя поля, в которое нужно записать полученный результат

Err=0
On Error Goto ErrLabel

Dim ws As New NotesUIWorkspace
Dim ui As NotesUIDocument
Set ui=ws.CurrentDocument ' текущий документ
Dim doc As NotesDocument
Set doc=ui.Document

Dim session As New NotesSession

Dim Num As Currency ' число, которое необходимо получить прописью
Num=Ccur(session.GetEnvironmentString("сумма"))

Dim stRub As String ' рубли
Dim stKop As String ' копейки
stRub=Cstr(Fix(Num))

If session.GetEnvironmentString("сумма-вид")="цена" Then
stKop=Cstr(Fraction(Num)*100)
If Len(stKop)<>2 Then
stNul=""
For i%=1 To 2-Len(stKop)
stNul=stNul & "0"
Next
stKop=stNul & stKop
End If
Else
stKop=""
End If

' Messagebox "stKop = " & stKop

Dim k As Integer ' количество "троек"
k=Fix(Len(stRub)/3)
If Len(stRub)<>k*3 Then
k=k+1
stNul=""
For i%=1 To k*3-Len(stRub)
stNul=stNul & "0"
Next
stRub=stNul & stRub
End If
' Messagebox "stRub = " & stRub

Dim st As String ' "тройка"
Dim stNum As String ' результат - число прописью
stNum=""

For i%=k To 1 Step -1
stProp=""
st100=""
st10=""
st1=""

' st=Mid(stRub,(i%-1)*3+1,i%*3)
st=Mid(stRub,(i%-1)*3+1,3)
If st="000" Then
If i%=k Then
If Fix(Num)=0 Then st100="ноль"
If session.GetEnvironmentString("сумма-вид")="цена" Then
stProp="рублей"
Else
stProp=""
End If
Goto LabelNum
Else
Goto LabelNext
End If
End If

' Сотни
' st100=""
Select Case Mid(st,1,1)
Case "1": st100="сто"
Case "2": st100="двести"
Case "3": st100="триста"
Case "4": st100="четыреста"
Case "5": st100="пятьсот"
Case "6": st100="шестьсот"
Case "7": st100="семьсот"
Case "8": st100="восемьсот"
Case "9": st100="девятьсот"
End Select

' Десятки
' st10=""
' st1=""
Select Case Mid(st,2,1)
Case "2": st10="двадцать"
Case "3": st10="тридцать"
Case "4": st10="сорок"
Case "5": st10="пятьдесят"
Case "6": st10="шестьдесят"
Case "7": st10="семьдесят"
Case "8": st10="восемьдесят"
Case "9": st10="девяносто"
End Select

' Единицы
If Mid(st,2,1)<>"1" Then
Select Case Mid(st,3,1)
Case "1":
If (k-i%+1)<>2 Then
st1="один"
Else
st1="одна"
End If
Case "2":
If (k-i%+1)<>2 Then
st1="два"
Else
st1="две"
End If
Case "3": st1="три"
Case "4": st1="четыре"
Case "5": st1="пять"
Case "6": st1="шесть"
Case "7": st1="семь"
Case "8": st1="восемь"
Case "9": st1="девять"
End Select
Else
Select Case Mid(st,2,2)
Case "10": st10="десять"
Case "11": st10="одиннадцать"
Case "12": st10="двенадцать"
Case "13": st10="тринадцать"
Case "14": st10="четырнадцать"
Case "15": st10="пятнадцать"
Case "16": st10="шестнадцать"
Case "17": st10="семнадцать"
Case "18": st10="восемнадцать"
Case "19": st10="девятнадцать"
End Select
End If

' Разряд - словом
' stProp=""
Select Case (k-i%+1)
Case 1:
If session.GetEnvironmentString("сумма-вид")="цена" Then
stProp=Prop(st,"рубл","ь","я","ей")
Else
stProp=""
End If
Case 2: stProp=Prop(st,"тысяч","а","и","")
Case 3: stProp=Prop(st,"миллион","","а","ов")
Case 4: stProp=Prop(st,"миллиард","","а","ов")
End Select

LabelNum:
stOld=stNum
stNum=st100
If st10<>"" Then stNum=Trim(stNum & " " & st10)
If st1<>"" Then stNum=Trim(stNum & " " & st1)
stNum=Trim(stNum & " " & stProp)
If stOld<>"" Then stNum=Trim(stNum & " " & stOld)

' Messagebox Cstr(i%) & ": " & stNum

LabelNext:
Next i%

Dim Kop As String ' копейки прописью
If session.GetEnvironmentString("сумма-вид")="цена" Then
Kop=Prop("0" & stKop,"копе","йка","йки","ек")
Else
Kop=""
End If

stNum=Trim(stNum & " " & stKop & " " & Kop)
stNum=Ucase(Left(stNum,1)) & Right(stNum,Len(stNum)-1)
' Messagebox stNum

' Запись полученного результата в отведенное поле
Dim FieldName As String ' имя поля
FieldName=session.GetEnvironmentString("сумма-имя")
Dim item As NotesItem
Set item=doc.GetFirstItem(FieldName)
item.Values=stNum
'Call ui.Refresh

ErrLabel:
If Err<>0 Then
Messagebox "[сумма прописью] Ошибка: " & Str(Err) & ": " & Error$ & " (в строке " & Str(Erl) & ")", 16
Err=0
End If

End Sub[/codebox]

Функция:

Function Prop (st As String, stMain As String, stEnd1 As String, stEnd2 As String, stEnd3 As String) As String
' Разряд (словом)

If Len(st)>=3 Then
If Mid(st,2,1)<>"1" Then
Select Case Mid (st,3,1)
Case "1": Prop=stMain & stEnd1
Case "2","3","4": Prop=stMain & stEnd2
Case "0","5","6","7","8","9": Prop=stMain & stEnd3
End Select
Else
Prop=stMain & stEnd3
End If
End If

End Function

Пример запуска:

@Command([ViewRefreshFields]);
@Environment("сумма";@Text(НДС;"F2"));
@Environment("сумма-имя";"всего_НДС_прописью");
@Environment("сумма-вид";"цена");
@Command([ToolsRunMacro];"(SummString)")

 

[K-Fire]

А вот мой вариант. Выдает число, без всяких приставок типа "рублей" или "рубля".
Тоже совсем неоптимально написано, зато даже дошкольник разберется

[codebox]Function NumberPropisiu( num As Long) As String
' берет целое число до 999 миллионов

res = ""
num1 = "000000000"+Cstr(num)
num1= Right(num1, 9)

curnum = Cint(Mid(num1,1,1))
Select Case curnum
Case 1: res = res + "сто "
Case 2: res = res + "двести "
Case 3: res = res + "триста "
Case 4: res = res + "четыреста "
Case 5: res = res + "пятьсот "
Case 6: res = res + "шестьсот "
Case 7: res = res + "семьсот "
Case 8: res = res + "восемьсот "
Case 9: res = res + "девятьсот "
End Select

If Cint(Mid(num1,1,1)) <> 0 And Cint(Mid(num1,2,1)) = 0 And Cint(Mid(num1,3,1)) = 0 Then
res = res + "миллионов "
End If

curnum = Cint(Mid(num1,2,1))
Select Case curnum
Case 1:
curnum1 = Cint(Mid(num1,3,1))
Select Case curnum1
Case 0: res = res + "десять миллионов "
Case 1: res = res + "одиннадцать миллионов "
Case 2: res = res + "двенадцать миллионов "
Case 3: res = res + "тринадцать миллионов "
Case 4: res = res + "четырнадцать миллионов "
Case 5: res = res + "пятнадцать миллионов "
Case 6: res = res + "шестнадцать миллионов "
Case 7: res = res + "семнадцать миллионов "
Case 8: res = res + "восемнадцать миллионов "
Case 9: res = res + "девятнадцать миллионов "
End Select
Case 2: res = res + "двадцать "
Case 3: res = res + "тридцать "
Case 4: res = res + "сорок "
Case 5: res = res + "пятьдесят "
Case 6: res = res + "шестьдесят "
Case 7: res = res + "семьдесят "
Case 8: res = res + "восемьдесят "
Case 9: res = res + "девяносто "
End Select

If Cint(Mid(num1,2,1)) <> 0 And Cint(Mid(num1,3,1)) = 0 Then
res = res + "миллионов "
End If

If Cint(Mid(num1,2,1)) <> 1 Then
curnum = Cint(Mid(num1,3,1))
Select Case curnum
Case 1: res = res + "один миллион "
Case 2: res = res + "два миллиона "
Case 3: res = res + "три миллиона "
Case 4: res = res + "четыре миллиона "
Case 5: res = res + "пять миллионов "
Case 6: res = res + "шесть миллионов "
Case 7: res = res + "семь миллионов "
Case 8: res = res + "восемь миллионов "
Case 9: res = res + "девять миллионов "
End Select
End If

curnum = Cint(Mid(num1,4,1))
Select Case curnum
Case 1: res = res + "сто "
Case 2: res = res + "двести "
Case 3: res = res + "триста "
Case 4: res = res + "четыреста "
Case 5: res = res + "пятьсот "
Case 6: res = res + "шестьсот "
Case 7: res = res + "семьсот "
Case 8: res = res + "восемьсот "
Case 9: res = res + "девятьсот "
End Select

If Cint(Mid(num1,4,1)) <> 0 And Cint(Mid(num1,5,1)) = 0 And Cint(Mid(num1,6,1)) = 0 Then
res = res + "тысяч "
End If


curnum = Cint(Mid(num1,5,1))
Select Case curnum
Case 1:
curnum1 = Cint(Mid(num1,6,1))
Select Case curnum1
Case 0: res = res + "десять тысяч "
Case 1: res = res + "одиннадцать тысяч "
Case 2: res = res + "двенадцать тысяч "
Case 3: res = res + "тринадцать тысяч "
Case 4: res = res + "четырнадцать тысяч "
Case 5: res = res + "пятнадцать тысяч "
Case 6: res = res + "шестнадцать тысяч "
Case 7: res = res + "семнадцать тысяч "
Case 8: res = res + "восемнадцать тысяч "
Case 9: res = res + "девятнадцать тысяч "
End Select
Case 2: res = res + "двадцать "
Case 3: res = res + "тридцать "
Case 4: res = res + "сорок "
Case 5: res = res + "пятьдесят "
Case 6: res = res + "шестьдесят "
Case 7: res = res + "семьдесят "
Case 8: res = res + "восемьдесят "
Case 9: res = res + "девяносто "
End Select

If Cint(Mid(num1,5,1)) <> 0 And Cint(Mid(num1,6,1)) = 0 Then
res = res + "тысяч "
End If

If Cint(Mid(num1,5,1)) <> 1 Then
curnum = Cint(Mid(num1,6,1))
Select Case curnum
Case 1: res = res + "одна тысяча "
Case 2: res = res + "две тысячи "
Case 3: res = res + "три тысячи "
Case 4: res = res + "четыре тысячи "
Case 5: res = res + "пять тысяч "
Case 6: res = res + "шесть тысяч "
Case 7: res = res + "семь тысяч "
Case 8: res = res + "восемь тысяч "
Case 9: res = res + "девять тысяч "
End Select
End If

curnum = Cint(Mid(num1,7,1))
Select Case curnum
Case 1: res = res + "сто "
Case 2: res = res + "двести "
Case 3: res = res + "триста "
Case 4: res = res + "четыреста "
Case 5: res = res + "пятьсот "
Case 6: res = res + "шестьсот "
Case 7: res = res + "семьсот "
Case 8: res = res + "восемьсот "
Case 9: res = res + "девятьсот "
End Select

curnum = Cint(Mid(num1,8,1))
Select Case curnum
Case 1:
curnum1 = Cint(Mid(num1,9,1))
Select Case curnum1
Case 0: res = res + "десять"
Case 1: res = res + "одиннадцать"
Case 2: res = res + "двенадцать"
Case 3: res = res + "тринадцать"
Case 4: res = res + "четырнадцать"
Case 5: res = res + "пятнадцать"
Case 6: res = res + "шестнадцать"
Case 7: res = res + "семнадцать"
Case 8: res = res + "восемнадцать"
Case 9: res = res + "девятнадцать"
End Select
Case 2: res = res + "двадцать "
Case 3: res = res + "тридцать "
Case 4: res = res + "сорок "
Case 5: res = res + "пятьдесят "
Case 6: res = res + "шестьдесят "
Case 7: res = res + "семьдесят "
Case 8: res = res + "восемьдесят "
Case 9: res = res + "девяносто "
End Select

If Cint(Mid(num1,8,1)) <> 1 Then
curnum = Cint(Mid(num1,9,1))
Select Case curnum
Case 1: res = res + "один"
Case 2: res = res + "два"
Case 3: res = res + "три"
Case 4: res = res + "четыре"
Case 5: res = res + "пять"
Case 6: res = res + "шесть"
Case 7: res = res + "семь"
Case 8: res = res + "восемь"
Case 9: res = res + "девять"
End Select
End If


NumberPropisiu = Trim(res)
End Function[/codebox]

 

[Kee_Keekkenen]

мой вариант, представлен в виде набора функций ...

вызов TranslateNumToStr(sum, curtype)
sum - числовое значение меньше миллиарда (тип double)
curtype - тип валюты (для примера в коде используются: Рубли, Доллары, Марки)

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

Declarations
'Возвращает только русскоязычный результат
'константы для определения грамматического рода денежной единицы
Const mtgMasculine = 0 
Const mtgFeminine = 1
Const mtgNeuter = 2

Const ZERO = "ноль"

Function AlignString(InpStr As String) As String
'Выравнивает строку до кол-ва символов кратных трем
Dim result As String

Result=InpStr
While Len(Result) Mod 3 <>0
Result="0" & Result
Wend
AlignString=Result

End Function

Function Convert(OrigStr As String, MoneyTitleGender As Integer) As String
'MoneyTitleGender - если mtgMasculine - то наименование денег - мужского рода, иначе - женского рода
Dim WorkStrLength As Integer
Dim TotalGroups As Integer
Dim WorkStr As String
Dim i As Integer
Dim Result As String
Dim Grp As String

WorkStr = AlignString(OrigStr)
WorkStrLength = Len(WorkStr)
TotalGroups = WorkStrLength / 3

For i=1 To TotalGroups
Grp = Left(Right(WorkStr,3*i),3)
Result = parsegroup(Grp,i,MoneyTitleGender) & Result		
Next
Convert=CompactString(result)
End Function

[codebox]Function ParseGroup(groupbody As String,groupnumber As Integer, MoneyTitleGender As Integer) As String
'MoneyTitleGender - если mtgMasculine - то наименование денег - мужского рода, иначе - женского рода

Dim masculineFrom0to9(0 To 9) As String
Dim feminineFrom0to9(0 To 9) As String
Dim neuterFrom0to9(0 To 9) As String
Dim From0to9 As Variant
Dim From10to19(0 To 9) As String
Dim From20to90(0 To 9) As String
Dim From100to900(0 To 9) As String
Dim result As String
Dim datastr(1 To 3) As String
Dim dataval(1 To 3) As Integer

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

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

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

From0to9 = masculineFrom0to9 'по умолчанию - мужской род

If groupnumber<=2 Then 'для чисел порядка больше миллиона - всегда мужской род
If MoneyTitleGender = mtgFeminine Then
From0to9 = feminineFrom0to9
End If
End If

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

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

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

datastr(1) = Right(groupbody,1)
datastr(2) = Mid(groupbody,2,1)
datastr(3) = Left(groupbody,1)

dataval(1) = Val(datastr(1))
dataval(2) = Val(datastr(2))
dataval(3) = Val(datastr(3))

'Если 000
If dataval(1)=0 And dataval(2)=0 And dataval(3)=0 Then
parsegroup= ""
Exit Function
End If

'Если число имеет формат x1x
If dataval(2)=1 Then
result = from10to19(dataval(1))
Else
result = from20to90(dataval(2)) &" " & from0to9(dataval(1)) &" " & result
End If

result=from100to900(dataval(3)) &" " & result

Select Case GroupNumber
Case 2 'Разряд тысяч
Select Case dataval(1)
Case 1
If dataval(2)=1 Then
result =result & " тысяч " 'одиннадцать тысяч
Else
result = Mid(result,1,Len(result)-3) & "на тысяча " 'делаем из один -> одна (тысяча)
End If

Case 2
If dataval(2)=1 Then
result =result & " тысяч " 'двенадцать тысяч
Else
result = Mid(result,1,Len(result)-2) & "е тысячи " 'делаем из два -> две (тысячи)
End If
Case 3,4
If dataval(2)=1 Then
result =result & " тысяч " 'тринадцать тысяч
Else
result = result & " тысячи "
End If

Case 0,5,6,7,8,9
result = result & " тысяч "
End Select

Case 3 'Разряд миллионов
Select Case dataval(1)
Case 1
If dataval(2)=1 Then
result = result & " миллионов " 'одиннадцать миллионов
Else
result = result & " миллион "
End If

Case 2,3,4
If dataval(2)=1 Then
result = result & " миллионов " 'двеннадцать миллионов
Else
result = result & " миллиона "
End If

Case 0,5,6,7,8,9
result = result & " миллионов "
End Select
End Select

parsegroup = result

End Function[/codebox]
[codebox]Function CompactString(InpData As String) As String

Dim limit As Integer
Dim PrevSpace As Integer 'Устанавливаю в 1, если встретился пробел, устанавливаю в 0, если встретится НЕ ПРОБЕЛ
Dim cnt As Integer
Dim currentchar As String
Dim WorkStr As String
Dim compactedstr As String

WorkStr =Trim(Inpdata)
compactedstr=""
prevspace=0
limit = Len(InpData)

For cnt=1 To limit
currentchar = Mid(WorkStr,cnt,1)
If currentchar=" " Then
If prevspace<>1 Then
prevspace=1
compactedstr = compactedstr & currentchar
End If
Else
prevspace=0
compactedstr = compactedstr & currentchar
End If
Next

CompactString = CompactedStr
End Function[/codebox]
[codebox]Function TranslateNumToStr(Num As Double, CurType As String) As String
On Error Goto ProcessError
'Точка входа в модуль Num2Str
'Возвращает прописью сумму

Const MaxValue = 999999999

Dim DataNum As Double 'содержит абсолютное значение параметра Num
Dim DollarStr As String 'содержит или строку "доллар" или "доллара" или "долларов" (или аналогично - про рубли)
Dim CentStr As String 'содержит или строку "цент" или "цента" или "центов" (или аналогично - про копейки)

Dim DollarPart As Double
Dim CentPart As Double
Dim mainPart As String
Dim PartSize As Integer
Dim mtg As Integer
Dim BanknoteName0 As String
Dim BanknoteName1 As String
Dim BanknoteName2 As String
Dim CoinName0 As String
Dim CoinName1 As String
Dim CoinName2 As String

Select Case CurType
Case "Рубли"
BanknoteName0 = "рубль"
BanknoteName1 = "рубля"
BanknoteName2 = "рублей"
CoinName0 = "копейка"
CoinName1 = "копейки"
CoinName2 = "копеек"
mtg = 0
Case "Доллары"
BanknoteName0 = "доллар"
BanknoteName1 = "доллара"
BanknoteName2 = "долларов"
CoinName0 = "цент"
CoinName1 = "цента"
CoinName2 = "центов"
mtg = 0
Case "Марки"
BanknoteName0 = "марка"
BanknoteName1 = "марки"
BanknoteName2 = "марок"
CoinName0 = "цент"
CoinName1 = "цента"
CoinName2 = "центов"
mtg = 1
End Select

If Num >MaxValue Then
Msgbox "Слишком большое число. Максимум для числа: " & MaxValue,48,"Ошибка"
TranslateNumToStr=""
Exit Function
End If

DataNum = Abs(Num)
DollarPart = Int(DataNum)
CentPart = Round(DataNum-DollarPart,2)*100

If DollarPart<>0 Then
PartSize = Len(Cstr(DollarPart))
Select Case Right(Cstr(DollarPart),1)
Case "1"
If PartSize>1 Then
If Left(Right(Cstr(DollarPart),2),1)="1" Then 'проверяем предпоследний символ
DollarStr=BanknoteName2 'долларов (рублей)
Else
DollarStr=BanknoteName0 'доллар (рубль)
End If
Else
DollarStr=BanknoteName0 'доллар (рубль)
End If

Case "2"
If PartSize>1 Then
If Left(Right(Cstr(DollarPart),2),1)="1" Then 'проверяем предпоследний символ
DollarStr=BanknoteName2 'долларов (рублей)
Else
DollarStr=BanknoteName1 'доллара (рубля)
End If
Else
DollarStr=BanknoteName1 'доллара (рубля)
End If

Case "3","4"
If PartSize>1 Then
If Left(Right(Cstr(DollarPart),2),1)="1" Then 'проверяем предпоследний символ
DollarStr=BanknoteName2 'долларов (рубля)
Else
DollarStr=BanknoteName1 'доллара (рубля)
End If
Else
DollarStr=BanknoteName1 'доллара (рубля)
End If

Case "0","5","6","7","8","9"
DollarStr=BanknoteName2 'долларов (рублей)
End Select
Else
DollarStr = BanknoteName2 'ноль долларов (рублей)
End If
'-x-x-x-x-x-x-
If CentPart<>0 Then

PartSize = Len(Cstr(CentPart))
Select Case Right(Cstr(CentPart),1)
Case "1"
If PartSize>1 Then
If Left(Right(Cstr(CentPart),2),1)="1" Then 'проверяем предпоследний символ
CentStr=CoinName2 ''центов (копеек)
Else
CentStr=CoinName0 ''цент (копейка)
End If
Else
CentStr=CoinName0 ''цент (копейка)
End If

Case "2"
If PartSize>1 Then
If Left(Right(Cstr(CentPart),2),1)="1" Then 'проверяем предпоследний символ
CentStr=CoinName2 ''центов (копеек)
Else
CentStr=CoinName1 ''цента (копейки)
End If
Else
CentStr=CoinName1 ''цента (копейки)
End If

Case "3","4"
If PartSize>1 Then
If Left(Right(Cstr(CentPart),2),1)="1" Then 'проверяем предпоследний символ
CentStr=CoinName2 ''центов (копеек)
Else
CentStr=CoinName1 ''цента (копейки)
End If
Else
CentStr=CoinName1 'цента (копейки)
End If

Case "0","5","6","7","8","9"
CentStr=CoinName2 ''центов (копеек)
End Select
Else 'ноль центов (копеек)
CentStr= CoinName2
End If

If DollarPart > 0 Then
mainPart = Convert(Cstr(DollarPart),mtg)
Else
mainPart = ZERO
End If

TranslateNumToStr = Ucase(Left(mainPart, 1)) & Right(mainPart, Len(mainPart) - 1) & " " & DollarStr & " " & Right("0" & Cstr(CentPart), 2) & " " & CentStr

Exit Function
ProcessError:
TranslateNumToStr = ""
Exit Function
End Function[/codebox]

 

[ironlogic]

Hi! Вот не помню где попался красмвый вариант на собаках ))

REM {--- вот тут надо настроить несколько параметров ---};
REM {Sum - имя поля, содержащего исходное число};
Number := Sum;
REM {Что выводить, если числовое поле не заполнено (т.е. тип значения - не число) };
NonNumberMsg := "<сумма не введена>";
REM {Что выводить, если число меньше нуля};
NegativeMsg := "<ошибка!>";
REM {Что выводить, если число равно нулю};
ZeroMsg := "";
REM {--- конец настроек ---};
@If(!@IsNumber(Number); @Return(NonNumberMsg); @Success);
@If(Number < 0; @Return(NegativeMsg); @Success);
@If(Number = 0; @Return(ZeroMsg); @Success);
@If(Number > 999999999999; @Return("слишком большое число"); @Success);
ThousandDelim:= @Middle(@Text(1000; "F,2");1;1);
Numbers := @Text(Number; "F,2");
NumbersL := @Length(Numbers);
ReformattedNumber := @Left (@Repeat("000"+ThousandDelim; 4); 18-NumbersL) + @Left(Numbers;NumbersL-3)+ThousandDelim+"0"+@Right(Numbers;2);
List := @Explode(ReformattedNumber; ThousandDelim);
teens:= "11":"12":"13":"14":"15":"16":"17":"18":"19";
digits := "0":"1":"2":"3":"4":"5":"6":"7":"8":"9";
teendigits:= "b":"c":"d":"e":"f":"g":"h":"i":"j";
teensf:= "0"+ teendigits;
hundreds := "":"сто ":"двести ":"триста ":"четыреста ":"пятьсот ":"шестьсот ":"семьсот ":"восемьсот ":"девятьсот ";
decades := "":"десять ":"двадцать ":"тридцать ":"сорок ":"пятьдесят ":"шестьдесят ":"семьдесят ":"восемьдесят ":"девяносто ";
ones := "":"":"один ":"одна ":"два ":"две ":"три ":"три ":"четыре ":"четыре ":"пять ":"пять ":
"шесть ":"шесть ":"семь ":"семь ":"восемь ":"восемь ":"девять ":"девять ":
"одиннадцать ":"одиннадцать ":"двенадцать ":"двенадцать ":"тринадцать ":
"тринадцать ":"четырнадцать ":"четырнадцать ":"пятнадцать ":"пятнадцать ":
"шестнадцать ":"шестнадцать ":"семнадцать ":"семнадцать ":"восемнадцать ":
"восемнадцать ":"девятнадцать ":"девятнадцать ";

dt := ((digits:teendigits)*+("m":"f"));
groupes := "0":"1":"2":"3":"4";
List1 := @Left(List; 1) + @Replace(@Right(List; 2); teens; teensf) + "m":"m":"f":"m":"f";
List2 := @Replace(@Left(List1; 1); digits; hundreds) + @Replace(@Middle(List1; 1;1);digits; decades)
+ @Replace(@Right(List1; 2);dt; ones) +@Replace( @Middle(List1;2;1)+"4":"3":"2":"1":"0";
"00":"01":"02":"03":"04":("2":"3":"4"*+groupes):("5":"6":"7":"8":"9":teendigits*+groupes);
@If(@Integer(Number)-Number !=0;"n0";"")	: @If(@Integer(Number)!=0;"n1";""):"":"":"":("2":"2":"2"*+groupes):("n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n"*+groupes) );

result :=@If(baks<=0;
@Trim(@ReplaceSubstring(@Implode(List2; ""); "1":"2":"n"*+groupes; "цент ":"доллар ":"тысяча ":
"миллион ":"миллиард ":"цента ":"доллара ":"тысячи ":"миллиона ":"миллиарда ":"центов ":"долларов ":"тысяч ":"миллионов ":"миллиардов "));
@Trim(@ReplaceSubstring(@Implode(List2; ""); "1":"2":"n"*+groupes; "копейка ":"рубль ":"тысяча ":
"миллион ":"миллиард ":"копейки ":"рубля ":"тысячи ":"миллиона ":"миллиарда ":"копеек ":"рублей ":"тысяч ":
"миллионов ":"миллиардов ")));
result

 

[TIA]

Ещё на @-формулах. Источник -

Ссылка скрыта от гостей

_R1:="один" : "два" : "три" : "четыре" : "пять" : "шесть" : "семь" : "восемь" : "девять";
_R1a:="одна" : "две" : "три" : "четыре" : "пять" : "шесть" : "семь" : "восемь" : "девять";
_R10:="десять" : "двадцать" : "тридцать" : "сорок" : "пятьдесят" : "шестьдесят" : "семьдесят" : "восемьдесят" : "девяносто";
_R20:="десять" : "одиннадцать" : "двенадцать" : "тринадцать" : "четырнадцать" : "пятнадцать" : "шестнадцать" :"семнадцать" : "восемнадцать" : "девятнадцать";
_R100:="сто" : "двести" : "триста" : "четыреста" : "пятьсот" : "шестьсот" : "семьсот" : "восемьсот" : "девятьсот";

DEFAULT Sum:=0;
_P := "0" + @Text(Sum; "F2");
_txtRES := @If(@Abs(Sum)<1; "ноль "; "");
_RB := "миллиард";
_RM := "миллион";
_RT := "тысяч";
_ER := @TextToNumber(@MiddleBack(_P; 4; -1));
_DR := @TextToNumber(@MiddleBack(_P; 5; -1));
_SR := @TextToNumber(@MiddleBack(_P; 6; -1));
_ET := @TextToNumber(@MiddleBack(_P; 7; -1));
_DT := @TextToNumber(@MiddleBack(_P; 8; -1));
_ST := @TextToNumber(@MiddleBack(_P; 9; -1));
_EM := @TextToNumber(@MiddleBack(_P; 10; -1));
_DM := @TextToNumber(@MiddleBack(_P; 11; -1));
_SM := @TextToNumber(@MiddleBack(_P; 12; -1));
_EB := @TextToNumber(@MiddleBack(_P; 13; -1));
_DB := @TextToNumber(@MiddleBack(_P; 14; -1));
_SB := @TextToNumber(@MiddleBack(_P; 15; -1));
REM "----Миллиарды-------------------";
_SBT := @If(_SB = 0; ""; @Subset(@Subset(_R100; _SB); -1)) + " ";
_DBT := @If(_DB = 0; ""; _DB > 1; @Subset(@Subset(_R10; _DB); -1) + " "; @Subset(@Subset(_R20; _EB + 1); -1) + " ");
_EBT := @If(_EB = 0; ""; _DB = 1; ""; @Subset(@Subset(_R1; _EB); -1) + " ");
@Set("_txtRES"; @If(_SB+_DB+_EB=0; _txtRES; _SBT +_DBT +_EBT+_RB + @If(_DB!=1; @If(_EB = 1; ""; _EB>1 & _EB < 5; "а"; "ов");"ов")+" "));
REM "----Миллионы---------------------";
_SMT := @If(_SM = 0; ""; @Subset(@Subset(_R100; _SM); -1)) + " ";
_DMT := @If(_DM = 0; ""; _DM > 1; @Subset(@Subset(_R10; _DM); -1) + " "; @Subset(@Subset(_R20; _EM + 1); -1) + " ");
_EMT := @If(_EM = 0; ""; _DM = 1; ""; @Subset(@Subset(_R1; _EM); -1) + " ");
@Set("_txtRES"; _txtRES + @If(_SM+_DM+_EM=0; ""; _SMT +_DMT +_EMT+_RM + @If(_DM!=1; @If(_EM=1; ""; _EM>1 & _EM < 5; "а"; "ов");"ов")+" "));
REM "----Тысячи (ж.р.)-----------------";
_STT := @If(_ST = 0; ""; @Subset(@Subset(_R100; _ST); -1)) + " ";
_DTT := @If(_DT = 0; ""; _DT > 1; @Subset(@Subset(_R10; _DT); -1) + " "; @Subset(@Subset(_R20; _ET + 1); -1) + " ");
_ETT := @If(_ET = 0; ""; _DT = 1; ""; @Subset(@Subset(_R1a; _ET); -1) + " ");
@Set("_txtRES"; _txtRES + @If(_ST+_DT+_ET=0; ""; _STT +_DTT +_ETT+_RT + @If(_DT!=1; @If(_ET = 1; "а"; _ET>1 & _ET < 5; "и";"");"")+" "));
REM "----Рубли--------------------------";
_SRT := @If(_SR = 0; ""; @Subset(@Subset(_R100; _SR); -1)) + " ";
_DRT := @If(_DR = 0; ""; _DR > 1; @Subset(@Subset(_R10; _DR); -1) + " "; @Subset(@Subset(_R20; _ER + 1); -1) + " ");
_ERT := @If(_ER = 0; ""; _DR = 1; ""; @Subset(@Subset(_R1; _ER); -1) + " ");
@Set("_txtRES"; _txtRES +_SRT +_DRT +_ERT);
@Set("_txtRES"; @Trim(_txtRES));
@UpperCase(@Left(_txtRES; 1)) + @RightBack(_txtRES; 1)

 

[Yakov]

При использовании формуле, представленной TIA, в Notes 8.5.1 обнаружен неприяный баг. 1234 предсавляется в виде "Двести тридцать четыре " вместо "Одна тысяча двести тридцать четыре ". Ниже фикс этого бага.
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Формула</div></div><div class="sp-body"><div class="sp-content">

_R1:="один" : "два" : "три" : "четыре" : "пять" : "шесть" : "семь" : "восемь" : "девять";
_R1a:="одна" : "две" : "три" : "четыре" : "пять" : "шесть" : "семь" : "восемь" : "девять";
_R10:="десять" : "двадцать" : "тридцать" : "сорок" : "пятьдесят" : "шестьдесят" : "семьдесят" : "восемьдесят" : "девяносто";
_R20:="десять" : "одиннадцать" : "двенадцать" : "тринадцать" : "четырнадцать" : "пятнадцать" : "шестнадцать" :"семнадцать" : "восемнадцать" : "девятнадцать";
_R100:="сто" : "двести" : "триста" : "четыреста" : "пятьсот" : "шестьсот" : "семьсот" : "восемьсот" : "девятьсот";

DEFAULT Sum:=0;
_P := "0" + @Text(Sum; "F2");
_txtRES := @If(@Abs(Sum)<1; "ноль "; "");
_RB := "миллиард";
_RM := "миллион";
_RT := "тысяч";
_ER := @TextToNumber(@MiddleBack(_P; 4; -1));
_DR := @TextToNumber(@MiddleBack(_P; 5; -1));
_SR := @TextToNumber(@MiddleBack(_P; 6; -1));
_ET := @TextToNumber(@MiddleBack(_P; 7; -1));
_DT := @TextToNumber(@MiddleBack(_P; 8; -1));
_ST := @TextToNumber(@MiddleBack(_P; 9; -1)); @If(@IsError(_ST); @Set("_ST"; 0); "");
_EM := @TextToNumber(@MiddleBack(_P; 10; -1));
_DM := @TextToNumber(@MiddleBack(_P; 11; -1));
_SM := @TextToNumber(@MiddleBack(_P; 12; -1)); @If(@IsError(_SM); @Set("_SM"; 0); "");
_EB := @TextToNumber(@MiddleBack(_P; 13; -1));
_DB := @TextToNumber(@MiddleBack(_P; 14; -1));
_SB := @TextToNumber(@MiddleBack(_P; 15; -1)); @If(@IsError(_SB); @Set("_SB"; 0); "");
REM "----Миллиарды-------------------";
_SBT := @If(_SB = 0; ""; @Subset(@Subset(_R100; _SB); -1)) + " ";
_DBT := @If(_DB = 0; ""; _DB > 1; @Subset(@Subset(_R10; _DB); -1) + " "; @Subset(@Subset(_R20; _EB + 1); -1) + " ");
_EBT := @If(_EB = 0; ""; _DB = 1; ""; @Subset(@Subset(_R1; _EB); -1) + " ");
@Set("_txtRES"; @If(_SB+_DB+_EB=0; _txtRES; _SBT +_DBT +_EBT+_RB + @If(_DB!=1; @If(_EB = 1; ""; _EB>1 & _EB < 5; "а"; "ов");"ов")+" "));
REM "----Миллионы---------------------";
_SMT := @If(_SM = 0; ""; @Subset(@Subset(_R100; _SM); -1)) + " ";
_DMT := @If(_DM = 0; ""; _DM > 1; @Subset(@Subset(_R10; _DM); -1) + " "; @Subset(@Subset(_R20; _EM + 1); -1) + " ");
_EMT := @If(_EM = 0; ""; _DM = 1; ""; @Subset(@Subset(_R1; _EM); -1) + " ");
@Set("_txtRES"; _txtRES + @If(_SM+_DM+_EM=0; ""; _SMT +_DMT +_EMT+_RM + @If(_DM!=1; @If(_EM=1; ""; _EM>1 & _EM < 5; "а"; "ов");"ов")+" "));
REM "----Тысячи (ж.р.)-----------------";
_STT := @If(_ST = 0; ""; @Subset(@Subset(_R100; _ST); -1)) + " ";
_DTT := @If(_DT = 0; ""; _DT > 1; @Subset(@Subset(_R10; _DT); -1) + " "; @Subset(@Subset(_R20; _ET + 1); -1) + " ");
_ETT := @If(_ET = 0; ""; _DT = 1; ""; @Subset(@Subset(_R1a; _ET); -1) + " ");
@Set("_txtRES"; _txtRES + @If(_ST+_DT+_ET=0; ""; _STT +_DTT +_ETT+_RT + @If(_DT!=1; @If(_ET = 1; "а"; _ET>1 & _ET < 5; "и";"");"")+" "));
REM "----Рубли--------------------------";
_SRT := @If(_SR = 0; ""; @Subset(@Subset(_R100; _SR); -1)) + " ";
_DRT := @If(_DR = 0; ""; _DR > 1; @Subset(@Subset(_R10; _DR); -1) + " "; @Subset(@Subset(_R20; _ER + 1); -1) + " ");
_ERT := @If(_ER = 0; ""; _DR = 1; ""; @Subset(@Subset(_R1; _ER); -1) + " ");
@Set("_txtRES"; _txtRES +_SRT +_DRT +_ERT);
@Set("_txtRES"; @Trim(_txtRES));
@UpperCase(@Left(_txtRES; 1)) + @RightBack(_txtRES; 1)

 

[alexkapustin]

вот код от меня

Sub Click(Source As Button)
Dim wrk As New NotesUIWorkspace

Set doc = wrk.CurrentDocument.Document

tmp = SpellCurrencySumm (Cdbl(doc.Summ(0)) )
doc.SummSpelled = tmp

tmp2 = SpellCurrencySumm (Cdbl(doc.Itogo_2(0)) )
doc.SummSpelled1 = tmp2



End Sub

а эту часть прописываем в глобалс

Function NumberToString(nNumber As Double) As String
Dim sOnes(0 To 20) As String
Dim sDecades(0 To 10) As String
Dim sHundreds(0 To 10) As String
Dim sThousands(1 To 5) As String
Dim sEnd(1 To 3) As String
Dim nLength As Long
Dim nPos As Long
Dim nCountDigits As Long
Dim nCountGroups As Long
Dim nDigit As Long
Dim nDigitTemp As Long
Dim nRest As Long
Dim sNumber As String
Dim sString As String
Dim sStringGroup As String
Dim bPresent As Long

If (nNumber > 999999999999999 Or nNumber < 0) Then
Exit Function
End If

sOnes(1) = "один"
sOnes(2) = "два"
sOnes(3) = "три"
sOnes(4) = "четыре"
sOnes(5) = "пять"
sOnes(6) = "шесть"
sOnes(7) = "семь"
sOnes(8) = "восемь"
sOnes(9) = "девять"
sOnes(10) = "десять"
sOnes(11) = "одинадцать"
sOnes(12) = "двенадцать"
sOnes(13) = "тринадцать"
sOnes(14) = "четырнадцать"
sOnes(15) = "пятнадцать"
sOnes(16) = "шестнадцать"
sOnes(17) = "семнадцать"
sOnes(18) = "восемнадцать"
sOnes(19) = "девятнадцать"

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

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

sThousands(2) = "тысяч"
sThousands(3) = "миллион"
sThousands(4) = "миллиард"
sThousands(5) = "триллион"

sNumber = Cstr(nNumber)
nLength = Len(sNumber)
nRest = nLength Mod 3

If (nRest <> 0) Then
nLength = nLength + 3 - nRest
sNumber = Left$("00", 3 - nRest) + sNumber
End If

nPos = nLength - 2
nCountGroups = 1
sString = ""

While (nPos >= 1)
nCountDigits = 0
sStringGroup = ""
bPresent = False

While (nCountDigits <> 3)
nDigit = Cint(Mid$(sNumber, nPos + nCountDigits, 1))

If (nDigit <> 0) Then
bPresent = True
End If

Select Case nCountDigits
Case 0
sStringGroup = sStringGroup + sHundreds(nDigit) + " "

Case 1
nDigitTemp = Cint(Mid$(sNumber, nPos + nCountDigits, 2))
If (nDigitTemp < 20 And nDigitTemp > 9) Then
nDigit = nDigitTemp
sStringGroup = sStringGroup + sOnes(nDigit) + " "
nCountDigits = 2
Else
sStringGroup = sStringGroup + sDecades(nDigit) + " "
End If

Case 2
If (nCountGroups = 2) Then
Select Case nDigit
Case 1
sStringGroup = sStringGroup + "одна "

Case 2
sStringGroup = sStringGroup + "две "

Case Else
sStringGroup = sStringGroup + sOnes(nDigit) + " "
End Select
Else
sStringGroup = sStringGroup + sOnes(nDigit) + " "
End If
End Select

nCountDigits = nCountDigits + 1
Wend

If (bPresent) Then
sStringGroup = sStringGroup + sThousands(nCountGroups)

If (nCountGroups > 1) Then
If (nCountGroups = 2) Then
sEnd(1) = "а "
sEnd(2) = "и "
sEnd(3) = " "
Else
sEnd(1) = " "
sEnd(2) = "а "
sEnd(3) = "ов "
End If

Select Case nDigit
Case 1
sStringGroup = sStringGroup + sEnd(1)

Case 2 To 4
sStringGroup = sStringGroup + sEnd(2)

Case Else
sStringGroup = sStringGroup + sEnd(3)
End Select
End If
End If

sString = sStringGroup + sString
nPos = nPos - 3
nCountGroups = nCountGroups + 1
Wend

NumberToString = Trim$(sString)
End Function

и тут еще

Function SpellCurrencySumm ( Number As Double) As String
Dim doc As NotesDocument
Dim s As String
Dim y As Double
Dim x As Double
Dim wrk As New NotesUIWorkspace
Set uidoc=wrk.CurrentDocument
Set doc=uidoc.Document

'====Преобразовываем целую часть в строку (Рубли)
x=Fix(Number)
n=Cstr(x)
su=Right(n,1)
If su="1" And Right(n,2)<>"11"Then
s="рубль"
Else
If su>"4" Or su ="0" Or su = "00" Then
s="рублей"
Else
If Right(n,2)<>"11" And Right(n,2)<>"12" And Right(n,2)<>"13" And Right(n,2)<>"14" Then
s="рубля"
Else
s="рублей"
End If
End If

End If

SpellCurrencySumm= NumberToString(x)+") "+s
tmp=SpellCurrencySumm
SpellCurrencySumm="(" + Ucase(Left(tmp,1))+Right(tmp,Len(tmp)-1)

End Function

 

[dzheyzhi]

Вот отлично работающий вариант, у нас на работе используется

Function PropisD$ (Sum As Double)
Dim M$ (0 To 2), T$(0 To 2), S$(1 To 9), D$(1 To 9), E$(0 To 19)
M$(0) = "миллион"
M$(1) = "миллиона"
M$(2) = "миллионов"
T$(0) = "тысяча"
T$(1) = "тысячи"
T$(2) = "тысяч"
S$(1) = "сто"
S$(2) = "двести"
S$(3) = "триста"
S$(4) = "четыреста"
S$(5) = "пятьсот"
S$(6) = "шестьсот"
S$(7) = "семьсот"
S$(8) = "восемьсот"
S$(9) = "девятьсот"
D$(1) = "десять"
D$(2) = "двадцать"
D$(3) = "тридцать"
D$(4) = "сорок"
D$(5) = "пятьдесят"
D$(6) = "шестьдесят"
D$(7) = "семьдесят"
D$(8) = "восемьдесят"
D$(9) = "девяносто"
E$(0) = "ноль"
E$(1) = "один"
E$(2) = "два"
E$(3) = "три"
E$(4) = "четыре"
E$(5) = "пять"
E$(6) = "шесть"
E$(7) = "семь"
E$(8) = "восемь"
E$(9) = "девять"
E$(10) = "десять"
E$(11) = "одиннадцать"
E$(12) = "двенадцать"
E$(13) = "тринадцать"
E$(14) = "четырнадцать"
E$(15) = "пятнадцать"
E$(16) = "шестнадцать"
E$(17) = "семнадцать"
E$(18) = "восемнадцать"
E$(19) = "девятнадцать"
Result$ = ""
If Sum = 0 Then Result$ = E$(0)
TSum = Sum
If TSum >= 1000000 Then
Temp% = Fix(Tsum / 1000000)
If Temp% >= 100 Then Result$ = Result$ + S$(Fix(Temp% / 100)) + " "
Temp% = Temp% - (Fix(Temp% / 100)*100)
If Temp% >= 20 Then 
Result$ = Result$ + D$(Fix(Temp% / 10)) + " "
Temp% = Temp% - (Fix(Temp% / 10)*10)
End If
If Temp% > 0 Then Result$ = Result$ + E$(Temp%) + " "
If Temp% = 1 Then Result$ = Result$ + M$(0) + " "
If Temp% > 1 And Temp% <= 4 Then Result$ = Result$ + M$(1) + " "
If Temp% > 4 Or Temp% = 0 Then Result$ = Result$ + M$(2) + " "
End If
Tsum = Tsum - (Fix(Tsum / 1000000)*1000000)
If TSum >= 1000 Then
Temp% = Fix(Tsum / 1000)
If Temp% >= 100 Then Result$ = Result$ + S$(Fix(Temp% / 100)) + " "
Temp% = Temp% - (Fix(Temp% / 100)*100)
If Temp% >= 20 Then 
Result$ = Result$ + D$(Fix(Temp% / 10)) + " "
Temp% = Temp% - (Fix(Temp% / 10)*10)
End If
If Temp% > 0 Then Result$ = Result$ + E$(Temp%) + " "
If Temp% = 1 Then Result$ = Result$ + T$(0) + " "
If Temp% > 1 And Temp% <= 4 Then Result$ = Result$ + T$(1) + " "
If Temp% > 4 Or Temp% = 0 Then Result$ = Result$ + T$(2) + " "
End If
Tsum = Tsum - (Fix(Tsum / 1000)*1000)
If TSum > 0 Then
Temp% = Fix(Tsum)
If Temp% >= 100 Then Result$ = Result$ + S$(Fix(Temp% / 100)) + " "
Temp% = Temp% - (Fix(Temp% / 100)*100)
If Temp% >= 20 Then
Result$ = Result$ + D$(Fix(Temp% / 10)) + " "
Temp% = Temp% - (Fix(Temp% / 10)*10)
End If
If Temp% > 0 Then Result$ = Result$ + E$(Temp%) + " "
End If
Kop# = Round((Sum# - Fix(Sum#)) * 100, 0)
'If Kop# <> 0 Then
Result$ = "(" + Result$ + "рублей " + "и " + CStr(Kop#) + " копеек.)"'Right("0" + Cstr(Kop#),2) + "/100" 
'End If
PropisD$ = Replace(Format(Left(Result$,1),">") + Right(Result$,Len(Result$) - 1), " )", ")")
End Function

 

[vited]

В этом коде есть баг
При вводе числа
1 100 000 - получается: один миллион сто рублей
если же указать
1 101 000 - то все корректно и получается: один миллион сто одна тысяча рублей
и тоже самое будет с миллионами если число больше миллиарда.
1 100 100 000 - получается: один миллиард сто сто рублей

Hi! Вот не помню где попался красмвый вариант на собаках ))

REM {--- вот тут надо настроить несколько параметров ---};
REM {Sum - имя поля, содержащего исходное число};
Number := Sum;
REM {Что выводить, если числовое поле не заполнено (т.е. тип значения - не число) };
NonNumberMsg := "<сумма не введена>";
REM {Что выводить, если число меньше нуля};
NegativeMsg := "<ошибка!>";
REM {Что выводить, если число равно нулю};
ZeroMsg := "";
REM {--- конец настроек ---};
@If(!@IsNumber(Number); @Return(NonNumberMsg); @Success);
@If(Number < 0; @Return(NegativeMsg); @Success);
@If(Number = 0; @Return(ZeroMsg); @Success);
@If(Number > 999999999999; @Return("слишком большое число"); @Success);
ThousandDelim:= @Middle(@Text(1000; "F,2");1;1);
Numbers := @Text(Number; "F,2");
NumbersL := @Length(Numbers);
ReformattedNumber := @Left (@Repeat("000"+ThousandDelim; 4); 18-NumbersL) + @Left(Numbers;NumbersL-3)+ThousandDelim+"0"+@Right(Numbers;2);
List := @Explode(ReformattedNumber; ThousandDelim);
teens:= "11":"12":"13":"14":"15":"16":"17":"18":"19";
digits := "0":"1":"2":"3":"4":"5":"6":"7":"8":"9";
teendigits:= "b":"c":"d":"e":"f":"g":"h":"i":"j";
teensf:= "0"+ teendigits;
hundreds := "":"сто ":"двести ":"триста ":"четыреста ":"пятьсот ":"шестьсот ":"семьсот ":"восемьсот ":"девятьсот ";
decades := "":"десять ":"двадцать ":"тридцать ":"сорок ":"пятьдесят ":"шестьдесят ":"семьдесят ":"восемьдесят ":"девяносто ";
ones := "":"":"один ":"одна ":"два ":"две ":"три ":"три ":"четыре ":"четыре ":"пять ":"пять ":
"шесть ":"шесть ":"семь ":"семь ":"восемь ":"восемь ":"девять ":"девять ":
"одиннадцать ":"одиннадцать ":"двенадцать ":"двенадцать ":"тринадцать ":
"тринадцать ":"четырнадцать ":"четырнадцать ":"пятнадцать ":"пятнадцать ":
"шестнадцать ":"шестнадцать ":"семнадцать ":"семнадцать ":"восемнадцать ":
"восемнадцать ":"девятнадцать ":"девятнадцать ";

dt := ((digits:teendigits)*+("m":"f"));
groupes := "0":"1":"2":"3":"4";
List1 := @Left(List; 1) + @Replace(@Right(List; 2); teens; teensf) + "m":"m":"f":"m":"f";
List2 := @Replace(@Left(List1; 1); digits; hundreds) + @Replace(@Middle(List1; 1;1);digits; decades)
+ @Replace(@Right(List1; 2);dt; ones) +@Replace( @Middle(List1;2;1)+"4":"3":"2":"1":"0";
"00":"01":"02":"03":"04":("2":"3":"4"*+groupes):("5":"6":"7":"8":"9":teendigits*+groupes);
@If(@Integer(Number)-Number !=0;"n0";"")    : @If(@Integer(Number)!=0;"n1";""):"":"":"":("2":"2":"2"*+groupes):("n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n"*+groupes) );

result :=@If(baks<=0;
@Trim(@ReplaceSubstring(@Implode(List2; ""); "1":"2":"n"*+groupes; "цент ":"доллар ":"тысяча ":
"миллион ":"миллиард ":"цента ":"доллара ":"тысячи ":"миллиона ":"миллиарда ":"центов ":"долларов ":"тысяч ":"миллионов ":"миллиардов "));
@Trim(@ReplaceSubstring(@Implode(List2; ""); "1":"2":"n"*+groupes; "копейка ":"рубль ":"тысяча ":
"миллион ":"миллиард ":"копейки ":"рубля ":"тысячи ":"миллиона ":"миллиарда ":"копеек ":"рублей ":"тысяч ":
"миллионов ":"миллиардов ")));
result

 

[vited]

Вдруг кому-то сэкономлю время
фик:

List2 := @Replace(@Left(List1; 1); digits; hundreds) + @Replace(@Middle(List1; 1;1);digits; decades)

+ @Replace(@Right(List1; 2);dt; ones) +@Replace( @Middle(List1;2;1)+"4":"3":"2":"1":"0";

"00":"01":"02":"03":"04":("2":"3":"4"*+groupes):("5":"6":"7":"8":"9":teendigits*+groupes);

@If(@Integer(Number)-Number !=0;"n0";"")    : @If(@Integer(Number)!=0;"n1";""):@If(Number>1000 & List[3] != "000";"n2";""):@If(Number>1000000 & List[2] != "000";"n3";""):@If(Number>1000000000;"n4";""):("2":"2":"2"*+groupes):("n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n":"n"*+groupes) );