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

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

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)")

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

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

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

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

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