MyTetra Share
Делитесь знаниями!
функцию прописи денежных рублевых сумм
Время создания: 31.07.2019 22:38
Раздел: !Закладки - VBA
Запись: adgaver/mytetra_base_New/master/base/15376501619y1rokcbxw/text.html на raw.githubusercontent.com

На скорую руку набросал функцию прописи денежных рублевых сумм

Функция VBA


Visual BasicВыделить код

Function NumToText(ByVal Num As Double) As String

 ' Возвращает числовое значение прописью в виде текста

' Ххххх ххххх хххххх рублей YY копееек

Dim Num_, Num0, Num1, Num2, Num3, Num4, Num5, Num6, Num7, Num8 As Integer

Dim Dig(1 To 19) As String  ' цифры и числа от 1 до 19

Dim Dec(1 To 10) As String  ' десятки

Dim Sot(1 To 9) As String   ' сотни

Dim strText1, strText2 As String

Dim L As Integer

Dig(1) = "один"

Dig(2) = "два"

Dig(3) = "три"

Dig(4) = "четыре"

Dig(5) = "пять"

Dig(6) = "шесть"

Dig(7) = "семь"

Dig(8) = "восемь"

Dig(9) = "девять"

Dig(10) = "десять"

Dig(11) = "одиннадцать"

Dig(12) = "двенадцать"

Dig(13) = "тринадцать"

Dig(14) = "четырнадцать"

Dig(15) = "пятнадцать"

Dig(16) = "шестнадцать"

Dig(17) = "семнадцать"

Dig(18) = "восемнадцать"

Dig(19) = "девятнадцать"

 

Dec(1) = "десять"

Dec(2) = "двадцать"

Dec(3) = "тридцать"

Dec(4) = "сорок"

Dec(5) = "пятьдесят"

Dec(6) = "шестьдесят"

Dec(7) = "семьдесят"

Dec(8) = "восемьдесят"

Dec(9) = "девяносто"

 

Sot(1) = "сто"

Sot(2) = "двести"

Sot(3) = "триста"

Sot(4) = "четыреста"

Sot(5) = "пятьсот"

Sot(6) = "шестьсот"

Sot(7) = "семьсот"

Sot(8) = "восемьсот"

Sot(9) = "девятьсот"

 

Num8 = Fix(Num / 100000000)

Num7 = Fix((Num - Num8 * 100000000) / 10000000)

Num6 = Fix((Num - Num8 * 100000000 - Num7 * 10000000) / 1000000)

Num5 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000) / 100000)

Num4 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000) / 10000)

Num3 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000) / 1000)

Num2 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000) / 100)

Num1 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100) / 10)

Num0 = Fix((Num - Num8 * 100000000 - Num7 * 10000000 - Num6 * 1000000 - Num5 * 100000 - Num4 * 10000 - Num3 * 1000 - Num2 * 100 - Num1 * 10))

Num_ = Fix((Num - Fix(Num)) * 100)

 

NumToText = ""

Select Case Num8    ' сотни миллионов

  Case Is > 9

        NumToText = "число > 999 999 999.99"

   Case Is > 0

        NumToText = NumToText & Sot(Num8)

End Select

 

Select Case Num7    ' десятки миллионов

  Case Is > 1

        NumToText = NumToText & " " & Dec(Num7)

   Case Is = 1

        If Num6 = 0 Then

            NumToText = NumToText & " десять миллионов "

        Else

            NumToText = NumToText & " " & Dig(Num7 * 10 + Num6) & " миллионов "

        End If

        GoTo Tysachi

End Select

                    ' единицы миллионов

If Num6 > 0 And Num7 <> 1 Then NumToText = NumToText & " " & Dig(Num6)

 

If NumToText <> "" Then

    Select Case Num6

        Case Is > 4

            NumToText = NumToText & " миллионов "

        Case Is > 1

            NumToText = NumToText & " миллиона "

        Case Is = 1

            NumToText = NumToText & " миллион "

        Case Is = 0

            NumToText = NumToText & " миллионов "

    End Select

End If

 

                    ' сотни тысяч

Tysachi:

If Num5 > 0 Then NumToText = NumToText & " " & Sot(Num5)

 

Select Case Num4    ' десятки тысяч

  Case Is > 1

        NumToText = NumToText & " " & Dec(Num4)

   Case Is = 1

        If Num3 = 0 Then

            NumToText = NumToText & " десять тысяч "

        Else

            NumToText = NumToText & " " & Dig(Num4 * 10 + Num3) & " тысяч "

        End If

        GoTo Rubl

End Select

                    ' единицы тысяч

Select Case Num3

    Case Is = 1

        NumToText = NumToText & " одна"

    Case Is = 2

        NumToText = NumToText & " две"

    Case Is > 2

        NumToText = NumToText & " " & Dig(Num3)

End Select

 

If Num5 <> 0 Or Num4 <> 0 Or Num3 <> 0 Then

    Select Case Num3

        Case Is > 4

            NumToText = NumToText & " тысяч "

        Case Is > 1

            NumToText = NumToText & " тысячи "

        Case Is = 1

            NumToText = NumToText & " тысяча "

        Case Else

            NumToText = NumToText & " тысяч "

    End Select

End If

                    ' сотни рублей

Rubl:

If Num2 > 0 Then NumToText = NumToText & Sot(Num2)

 

Select Case Num1    ' десятки рублей

  Case Is > 1

        NumToText = NumToText & " " & Dec(Num1)

   Case Is = 1

        If Num0 = 0 Then

            NumToText = NumToText & " десять рублей"

        Else

            NumToText = NumToText & " " & Dig(Num1 * 10 + Num0) & " рублей"

        End If

        GoTo Kopeika

End Select

                    ' единицы рублей

If Num0 > 0 And Num1 <> 1 Then NumToText = NumToText & " " & Dig(Num0)

 

Select Case Num0

   Case Is > 4

        NumToText = NumToText & " рублей "

   Case Is > 1

        NumToText = NumToText & " рубля "

   Case Is = 1

        NumToText = NumToText & " рубль "

   Case Is = 0

        NumToText = NumToText & " рублей "

End Select

Kopeika:

                    ' копейки

NumToText = NumToText & " " & Format(Num_, "00")

Select Case Num_

    Case Is > 4

        NumToText = NumToText & " копеек"

    Case Is > 1

        NumToText = NumToText & " копейки"

    Case Is = 1

        NumToText = NumToText & " копейка"

    Case Is = 0

        NumToText = NumToText & " копеек"

End Select

            ' заглавная первая буква

NumToText = LTrim(NumToText)

L = Len(NumToText)

strText1 = Left(NumToText, 1)

strText2 = Right(NumToText, L - 1)

NumToText = UCase(strText1) & strText2

End Function

Последний раз редактировалось Ameli; 02.04.2012 в 10:49.

Так же в этом разделе:
 
MyTetra Share v.0.55
Яндекс индекс цитирования