Кодинг

[TOSHIK]

(c) dBaser

Public Function funSupr(xsu As Currency, Optional mb As Byte) As String
' прописью в рублях по-русски
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
funSupr = ""
Exit Function
End If
If xsu >= 10000000000000# Then
funSupr = "слишком большое число"
Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
funSupr = "ноль рублей "
Else
ssu = Mid$(str$(Fix(xsu)), 2)
nsu = (Len(ssu) + 2) \ 3
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
For i = nsu To 1 Step -1
sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1))
des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1))
edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1))
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
funSupr = funSupr + Choose(sot, "сто", "двести", "триста", _
"четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
"девятьсот") + " "
End If
If des = 1 Then
funSupr = funSupr + Choose(edi + 1, "десять", "одиннадцать", _
"двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
"семнадцать", "восемнадцать", "девятнадцать") + " "
ind = 3
Else
If des <> 0 Then
funSupr = funSupr + Choose(des - 1, "двадцать", _
"тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _
"девяносто") + " "
End If
If edi <> 0 Then
If i = 2 And (edi = 1 Or edi = 2) Then
ind = 9
Else
ind = 0
End If
funSupr = funSupr + Choose(edi + ind, "один", "два", _
"три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _
"две") + " "
End If
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + Choose((i - 1) * 3 + ind, "рубль", "рубля", _
"рублей", "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _
"миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _
"триллионов") + " "
End If
Next i
End If
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + ssu + Choose(ind, " копейка", " копейки", " копеек")
If mb = 0 Then
funSupr = UCase$(Left$(funSupr, 1)) + Mid$(funSupr, 2)
End If
Exit Function
ersupr:
funSupr = "ошибка"
End Function
________________________________________


Public Function funSuprUSD(xsu As Currency, Optional mb As Byte) As String
'прописью в $ по- русски
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
funSuprUSD = ""
Exit Function
End If
If xsu >= 10000000000000# Then
funSuprUSD = "слишком большое число"
Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
funSuprUSD = "ноль долларов "
Else
ssu = Mid$(str$(Fix(xsu)), 2)
nsu = (Len(ssu) + 2) \ 3
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
For i = nsu To 1 Step -1
sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1))
des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1))
edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1))
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
funSuprUSD = funSuprUSD + Choose(sot, "сто", "двести", "триста", _
"четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
"девятьсот") + " "
End If
If des = 1 Then
funSuprUSD = funSuprUSD + Choose(edi + 1, "десять", "одиннадцать", _
"двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
"семнадцать", "восемнадцать", "девятнадцать") + " "
ind = 3
Else
If des <> 0 Then
funSuprUSD = funSuprUSD + Choose(des - 1, "двадцать", _
"тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _
"девяносто") + " "
End If
If edi <> 0 Then
If i = 2 And (edi = 1 Or edi = 2) Then
ind = 9
Else
ind = 0
End If
funSuprUSD = funSuprUSD + Choose(edi + ind, "один", "два", _
"три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _
"две") + " "
End If
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSuprUSD = funSuprUSD + Choose((i - 1) * 3 + ind, "доллар", "доллара", _
"долларов", "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _
"миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _
"триллионов") + " "
End If
Next i
End If
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSuprUSD = funSuprUSD + ssu + Choose(ind, " цент", " цента", " центов")
If mb = 0 Then
funSuprUSD = UCase$(Left$(funSuprUSD, 1)) + Mid$(funSuprUSD, 2)
End If
Exit Function
ersupr:
funSuprUSD = "ошибка"
End Function
________________________________________

Public Function funSuprUSDeng(xsu As Currency, Optional mb As Byte) As String
'прописью в $ по-английски
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
funSuprUSDeng = ""
Exit Function
End If
If xsu >= 10000000000000# Then
funSuprUSDeng = " multitude"
Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
funSuprUSDeng = "null dollars "
Else
ssu = Mid$(str$(Fix(xsu)), 2)
If ssu = 1 Then
funSuprUSDeng = "One dollar "
nsu = (Len(ssu) + 2) \ 3
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
GoTo ivan
End If
nsu = (Len(ssu) + 2) \ 3
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
For i = nsu To 1 Step -1
sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1))
des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1))
edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1))
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
funSuprUSDeng = funSuprUSDeng + Choose(sot, "one hundred", "two hundred", "three hundred", _
"four hundred", "five hundred", "six hundred", "seven hundred", "eight hundred", _
"nine hundred") + " "
End If
If des = 1 Then
funSuprUSDeng = funSuprUSDeng + Choose(edi + 1, "ten", "eleven", _
"twelve", "thirteen", "fourteen", "fifteen", "sixteen", _
"seventeen", "eighteen", "nineteen") + " "
ind = 3
Else
If des <> 0 Then
funSuprUSDeng = funSuprUSDeng + Choose(des - 1, "twenty", _
"thirty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety") + " "
End If
If edi <> 0 Then
If i = 2 And (edi = 1 Or edi = 2) Then
ind = 9
Else
ind = 0
End If
funSuprUSDeng = funSuprUSDeng + Choose(edi + ind, "one ", "two ", _
"three ", "four ", "five ", "six ", "seven ", "eight ", "nine ", "one", "two") + " "
End If
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSuprUSDeng = funSuprUSDeng + Choose((i - 1) * 3 + ind, "dollars", "dollars", _
"dollars", "thousand", "thousand", "thousand", "million", "million", "million", _
"milliard", "milliard", "milliard", "trillion", "trillion", _
"trillion") + " "
End If
Next i
End If
ivan:
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If ssu = 1 Then
ind = 1
Else
ind = 2
End If
funSuprUSDeng = funSuprUSDeng + ssu + Choose(ind, " cent", " cents")
If mb = 0 Then
funSuprUSDeng = UCase$(Left$(funSuprUSDeng, 1)) + Mid$(funSuprUSDeng, 2)
End If
Exit Function
ersupr:
funSuprUSDeng = err.Number & " " & err.Description
End Function