Tips Forum Logo
Tips Forum Home PageSpacerVisit Microsoft Knowledge BaseMAUG Home PageMAUG Russian Home Page

SMPL:Функция преобазования числа в текст (123 в сто двадцать три руб.)
SMPL: How to print value it words (123 in to one hundred twenty three dollars) (Russian only)

Applies to: All Access Versions


Function RUB(curSum As Currency, Optional blnCent, Optional strDollarPart, Optional strCentPart) As String
On Error GoTo RUB_Error
Dim strPart6 As String
Dim strPart3 As String
Dim strPart0 As String
Dim lngInt As Long
Dim strRubOut As String

If curSum > 0 Then
If IsMissing(blnCent) Then
lngInt = CLng(curSum)
Else
lngInt = Int(curSum)
End If

If lngInt >= 1000000 Then
If Right$(Num_string_up_t(Fix(lngInt / 1000000), 0), 5) = "один " Then
strPart6 = Num_string_up_t(Fix(lngInt / 1000000), 0) & "миллион "
ElseIf Right$(Num_string_up_t(Fix(lngInt / 1000000), 0), 4) = "два " Or Right$(Num_string_up_t(Fix(lngInt / 1000000), 0), 4) = "три " Or Right$(Num_string_up_t(Fix(lngInt / 1000000), 0), 7) = "четыре " Then
strPart6 = Num_string_up_t(Fix(lngInt / 1000000), 0) & "миллиона "
Else: strPart6 = Num_string_up_t(Fix(lngInt / 1000000), 0) & "миллионов "
End If
End If


If lngInt >= 1000000 Then lngInt = lngInt - 1000000 * Fix(lngInt / 1000000)

If lngInt >= 1000 Then
If Right$(Num_string_up_t(Fix(lngInt / 1000), 1), 5) = "одна " Then
strPart3 = Num_string_up_t(Fix(lngInt / 1000), 1) & "тысяча "
ElseIf Right$(Num_string_up_t(Fix(lngInt / 1000), 1), 4) = "две " Or Right$(Num_string_up_t(Fix(lngInt / 1000), 1), 4) = "три " Or Right$(Num_string_up_t(Fix(lngInt / 1000), 1), 7) = "четыре " Then
strPart3 = Num_string_up_t(Fix(lngInt / 1000), 1) & "тысячи "
Else
strPart3 = Num_string_up_t(Fix(lngInt / 1000), 1) & "тысяч "
End If
End If

If lngInt >= 1000 Then lngInt = lngInt - 1000 * Fix(lngInt / 1000)

strPart0 = Num_string_up_t(lngInt, 0)

strRubOut = UCase$(Left$(strPart6 & strPart3 & strPart0, 1)) & Mid$(strPart6 & strPart3 & strPart0, 2)

If IsMissing(strDollarPart) Then
strRubOut = strRubOut + "руб."
Else
strRubOut = strRubOut + strDollarPart
End If
strRubOut = strRubOut + " "
If IsMissing(strCentPart) Then
If IsMissing(blnCent) Then
strRubOut = strRubOut + Format$(0, "00 ") + "коп."
Else
strRubOut = strRubOut + Format$((curSum - Int(curSum)) * 100, "00 ") + "коп."
End If
Else
If IsMissing(blnCent) Then
strRubOut = strRubOut + Format$(0, "00 ") + strCentPart
Else
strRubOut = strRubOut + Format$((curSum - Int(curSum)) * 100, "00 ") + strCentPart
End If
End If

RUB = strRubOut
Else
RUB = "0.00"
End If
RUB_Exit:
Exit Function

RUB_Error:
MsgBox Err.Description
Resume RUB_Exit
End Function
Function Num_string_hungr(n)
Select Case n
Case 0: Num_string_hungr = " "
Case 1: Num_string_hungr = "сто "
Case 2: Num_string_hungr = "двести "
Case 3: Num_string_hungr = "триста "
Case 4: Num_string_hungr = "четыреста "
Case 5: Num_string_hungr = "пятьсот "
Case 6: Num_string_hungr = "шестьсот "
Case 7: Num_string_hungr = "семьсот "
Case 8: Num_string_hungr = "восемьсот "
Case 9: Num_string_hungr = "девятьсот "
End Select
End Function
Function Num_string_tens(n)
Select Case n
Case 0: Num_string_tens = " "
Case 1: Num_string_tens = " "
Case 2: Num_string_tens = "двадцать "
Case 3: Num_string_tens = "тридцать "
Case 4: Num_string_tens = "сорок "
Case 5: Num_string_tens = "пятьдесят "
Case 6: Num_string_tens = "шестьдесят "
Case 7: Num_string_tens = "семьдесят "
Case 8: Num_string_tens = "восемьдесят "
Case 9: Num_string_tens = "девяносто "
End Select
End Function
Function Num_string_twenty(n, m)
Select Case n
Case 0: Num_string_twenty = " "
Case 1: Num_string_twenty = "один "
Case 2: Num_string_twenty = "два "
Case 3: Num_string_twenty = "три "
Case 4: Num_string_twenty = "четыре "
Case 5: Num_string_twenty = "пять "
Case 6: Num_string_twenty = "шесть "
Case 7: Num_string_twenty = "семь "
Case 8: Num_string_twenty = "восемь "
Case 9: Num_string_twenty = "девять "
Case 10: Num_string_twenty = "десять "
Case 11: Num_string_twenty = "одиннадцать "
Case 12: Num_string_twenty = "двенадцать "
Case 13: Num_string_twenty = "тринадцать "
Case 14: Num_string_twenty = "четырнадцать "
Case 15: Num_string_twenty = "пятнадцать "
Case 16: Num_string_twenty = "шестнадцать "
Case 17: Num_string_twenty = "семнадцать "
Case 18: Num_string_twenty = "восемнадцать "
Case 19: Num_string_twenty = "девятнадцать "
End Select

If m = 1 And n = 1 Then Num_string_twenty = "одна "
If m = 1 And n = 2 Then Num_string_twenty = "две "
End Function
Function Num_string_up_t(k, z)
Dim nsut1

Dim nsut3
Dim nsut4

If k >= 100 Then nsut1 = Num_string_hungr(Fix(k / 100)) Else nsut1 = ""
If k >= 100 Then k = k - 100 * Fix(k / 100)
If k >= 20 Then nsut3 = Num_string_tens(Fix(k / 10)) & Num_string_twenty(k - 10 * Fix(k / 10), z)
nsut4 = Num_string_twenty(k, z)
Num_string_up_t = nsut1 & nsut3 & nsut4
End Function

From  Alex Dybenko , Entry Date 29.05.97



Microsoft Access Solutions

Written and designed by
Alex Dybenko
Send us your comments
Last Update: 2007-10-15
Copyright © 1998-2007 by MAUG

Alex & Access