Check forum, I saw program...

Good luck

If you need English ---> ASK me , I have code... 

Ответить

'Преобразование цены nMod в сумму прописью
'Работает при nMod<=2 147 483 647
'Код для рублей
Function Translate(nMon) As String
Dim aGen
Dim nCurSum, nCurRest, k

    aGen = Array("М", "Ж", "М", "М")
    Translate = ""
    On Error Resume Next
    nCurSum = CLng(nMon - 0.49)
    If Err.Number <> 0 Then
        Translate = Trim(nMon)
        Exit Function
    End If
    For k = 1 To 4
        If k > 1 Then nCurSum = (nCurSum - nCurRest) / 1000
        nCurSum = CLng(nCurSum - 0.49)
        If nCurSum = 0 Then Exit For
        nCurRest = nCurSum Mod 1000
        Translate = Money_Word(aGen(k - 1), k, nCurSum, True) & Translate
    Next
    nCurSum = CLng((nMon - CLng(nMon - 0.49)) * 100)
    Translate = Translate & Right(Left("0" & nCurSum, 3), 2) & " " & Money_Word("Ж", 0, nCurSum, False)
End Function

'Вывод словесной формы числа
'cGen - род (М-мужской,Ж-женский,С-средний)
'k - порядок (группа в aOrd)
'nCurSum - число для преобразования
'bWord - True-выводить весь текст, False-выводить только размерность
Function Money_Word(cGen, k, nCurSum, bWord)
Dim nSum, nRest, nCurRest
Dim aOrd, aDigits, aTens, aHundreds
    aOrd = Array("копейка", "копейки", "копеек" _
    , "рубль", "ру[sensored]", "рублей" _
    , "тысяча", "тысячи", "тысяч" _
    , "миллион", "миллиона", "миллионов" _
    , "миллиард", "миллиарда", "миллиардов")
    aDigits = Array("", "", "три", "четыре", "пять", "шесть", "семь", "восемь" _
    , "девять", "десять", "одиннадцать", "двенадцать", "тринадцать" _
    , "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать" _
    , "восемнадцать", "девятнадцать")
    aTens = Array("десять", "двадцать", "тридцать", "сорок", "пятьдесят" _
    , "шестьдесят", "семьдесят", "восемьдесят", "девяносто")
    aHundreds = Array("сто", "двести", "триста", "четыреста", "пятьсот" _
    , "шестьсот", "семьсот", "восемьсот", "девятьсот")
    Money_Word = ""
    If cGen = "М" Then
        aDigits(0) = "один"
        aDigits(1) = "два"
    ElseIf cGen = "Ж" Then
        aDigits(0) = "одна"
        aDigits(1) = "две"
    ElseIf cGen = "С" Then
        aDigits(0) = "одно"
        aDigits(1) = "два"
    End If
    nRest = nCurSum Mod 10
    nSum = nCurSum Mod 100
    If nSum > 10 And nSum < 20 Then
        Money_Word = aOrd(k * 3 + 2) & " " & Money_Word
    ElseIf nRest = 1 Then
        Money_Word = aOrd(k * 3 + 0) & " " & Money_Word
    ElseIf nRest > 1 And nRest < 5 Then
        Money_Word = aOrd(k * 3 + 1) & " " & Money_Word
    Else
        Money_Word = aOrd(k * 3 + 2) & " " & Money_Word
    End If
    If bWord = False Then Exit Function
    nSum = nCurSum Mod 1000
    nRest = nSum Mod 100
    If nRest > 19 Then
        nRest = nRest Mod 10
        If nRest > 0 Then Money_Word = aDigits(nRest - 1) & " " & Money_Word
        nRest = ((nSum Mod 100) - nRest) / 10
        Money_Word = aTens(nRest - 1) & " " & Money_Word
    ElseIf nRest > 0 Then
        Money_Word = aDigits(nRest - 1) & " " & Money_Word
    End If
    nSum = (nSum - (nSum Mod 100)) / 100
    If nSum > 0 Then Money_Word = aHundreds(nSum - 1) & " " & Money_Word
End Function

Ответить

Ответить