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

Тема в разделе "Библиотеки скриптов", создана пользователем morpheus, 9 янв 2007.

  1. morpheus

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
    Вопрос
    Очень часто появляеться необходимость написать некоторые числа прописью (243=двести-сорок-три), как это зделать?

    Ответ
    [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]

    Комментарий
    Автор
    aks
     
  2. K-Fire

    K-Fire Гость

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

    Код (Text):
    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-у это сильно :D



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

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
    <!--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]
    Хм... незаметил... будем править
     
  4. Azrael

    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]

    Функция:
    Код (Text):
    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
    Пример запуска:
    Код (Text):
    @Command([ViewRefreshFields]);
    @Environment("сумма";@Text(НДС;"F2"));
    @Environment("сумма-имя";"всего_НДС_прописью");
    @Environment("сумма-вид";"цена");
    @Command([ToolsRunMacro];"(SummString)")
     
  5. K-Fire

    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]
     
  6. Kee_Keekkenen

    Kee_Keekkenen Well-Known Member

    Регистрация:
    5 сен 2006
    Сообщения:
    616
    Симпатии:
    4
    мой вариант, представлен в виде набора функций ...

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

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

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

    Const ZERO = "ноль"
    Код (Text):
    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
    Код (Text):
    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]
     
  7. ironlogic

    ironlogic New Member

    Регистрация:
    29 окт 2009
    Сообщения:
    1
    Симпатии:
    0
    Hi! Вот не помню где попался красмвый вариант на собаках ))

    Код (Text):
    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
     
  8. TIA

    TIA :-)
    Lotus team

    Регистрация:
    15 май 2009
    Сообщения:
    790
    Симпатии:
    0
    Ещё на @-формулах. Источник - форум ИнтерТраст

    _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)
     
  9. Yakov

    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">
    Код (Text):
    _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)
     
  10. alexkapustin

    alexkapustin Гость

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

    Код (LotusScript):
     
    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
    Код ( (Unknown Language)):
     

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

    Код (LotusScript):
     
    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

    Код ( (Unknown Language)):
     
    и тут еще
    Код (LotusScript):
     
    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
    Код ( (Unknown Language)):
     
     
  11. dzheyzhi

    dzheyzhi Active Member

    Регистрация:
    8 дек 2011
    Сообщения:
    30
    Симпатии:
    0
    Вот отлично работающий вариант, у нас на работе используется ;)
    Код (LotusScript):
    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
     
Загрузка...

Поделиться этой страницей