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
|