[oodisc] Сумма прописью

[Mikhail Goussev]

Sub main()

Dim dd As Double
Dim st As String

dd = 21.2234

' 0 - rub
' 1 - y.e.

st = Digit2String(dd, 1)

End Sub

Function Digit2String(digit As Double, p As Integer) As String

' Макрос записан 18.06.01 mikle-2
Dim W1(20) As String
Dim W1a(20) As String
Dim W10(10) As String
Dim W100(10) As String
Dim W1000(10) As String

W1(0) = ""
W1(1) = "один"
W1(2) = "два"
W1(3) = "три"
W1(4) = "четыре"
W1(5) = "пять"
W1(6) = "шесть"
W1(7) = "семь"
W1(8) = "восемь"
W1(9) = "девять"
W1(10) = "десять"
W1(11) = "одинадцать"
W1(12) = "двенадцать"
W1(13) = "тринадцать"
W1(14) = "четырнадцать"
W1(15) = "пятнадцать"
W1(16) = "шестнадцать"
W1(17) = "семнадцать"
W1(18) = "восемнадцать"
W1(19) = "девятнадцать"
W1a(0) = ""
W1a(1) = "одна"
W1a(2) = "две"
W1a(3) = "три"
W1a(4) = "четыре"
W1a(5) = "пять"
W1a(6) = "шесть"
W1a(7) = "семь"
W1a(8) = "восемь"
W1a(9) = "девять"
W1a(10) = "десять"
W1a(11) = "одинадцать"
W1a(12) = "двенадцать"
W1a(13) = "тринадцать"
W1a(14) = "четырнадцать"
W1a(15) = "пятнадцать"
W1a(16) = "шестнадцать"
W1a(17) = "семнадцать"
W1a(18) = "восемнадцать"
W1a(19) = "девятнадцать"
W10(0) = ""
W10(1) = "десять"
W10(2) = "двадцать"
W10(3) = "тридцать"
W10(4) = "сорок"
W10(5) = "пятьдесят"
W10(6) = "шестьдесят"
W10(7) = "семьдесят"
W10(8) = "восемьдесят"
W10(9) = "девяносто"
W100(0) = ""
W100(1) = "сто"
W100(2) = "двести"
W100(3) = "триста"
W100(4) = "четыреста"
W100(5) = "пятьсот"
W100(6) = "шестьсот"
W100(7) = "семьсот"
W100(8) = "восемьсот"
W100(9) = "девятьсот"

Result = ""

e = Int((digit - Int(digit)) * 100) ' decimal
digit_long = Int(digit)
a = Int(digit_long / 1000000) '32123456/1000000 = 32 -> 10^6
b = digit_long - (a * 1000000) '32123456-32000000 = 123456
c = Int(b / 1000) '123456/1000 = 123 -> 10^3
d = b - (c * 1000) '123456-123*1000 = 456 -> 1

Add = ""
For i = 2 To 0 Step -1
    m = Int(a / (10 ^ i))
    If i = 2 Then
        If m <> 0 Then
            R = W100(m) + " "
            Add = "миллионов "
        End If
    End If
    If i = 1 Then
        If m <> 0 Then
            If a < 20 Then
                Result = Result + W1(a) + " миллионов "
                GoTo con_0
            End If
            R = W10(m) + " "
            Add = "миллионов "
        End If
    End If
    If i = 0 Then
        If m <> 0 Then
            If m >= 5 Then
                R = W1(m) + " "
                Add = "миллионов "
            End If
            If m <= 4 Then
                R = W1(m) + " "
                Add = "миллиона "
            End If
            If m = 1 Then
                R = "один "
                Add = "миллион "
            End If
        End If
        
    End If
    a = a - (m * (10 ^ i))
    Result = Result + R
    R = ""
Next i
Result = Result + Add
con_0:

Add = ""
For i = 2 To 0 Step -1
    m = Int(c / (10 ^ i))
    If i = 2 Then
        If m <> 0 Then
            R = W100(m) + " "
            Add = "тысяч "
        End If
    End If
    If i = 1 Then
        If m <> 0 Then
            If c < 20 Then
                Result = Result + W1(c) + " тысяч "
                GoTo con_1
            End If
            R = W10(m) + " "
            Add = "тысяч "
        End If
    End If
    If i = 0 Then
        If m <> 0 Then
            If m >= 5 Then
                R = W1(m) + " "
                Add = "тысяч "
            End If
            If m <= 4 Then
                R = W1(m) + " "
                Add = "тысячи "
            End If
            If m = 2 Then
                R = "две "
                Add = "тысячи "
            End If
            If m = 1 Then
                R = "одна "
                Add = "тысяча "
            End If
        End If
    End If
    c = c - (m * (10 ^ i))
    Result = Result + R
    R = ""
Next i
Result = Result + Add
con_1:

Add = ""
For i = 2 To 0 Step -1
    m = Int(d / (10 ^ i))
    If i = 2 Then
        If m <> 0 Then
            R = W100(m) + " "
        End If
    End If
    If i = 1 Then
        If m <> 0 Then
            If d < 20 Then
                R = W1(d) + " "
                Result = Result + R
                GoTo con_2
            End If
            R = W10(m) + " "
        End If
    End If
    If i = 0 Then
        If m <> 0 Then
            If p = 0 Then
                R = W1(m) + " "
            Else
                R = W1a(m) + " "
            End If
        End If
    End If
    
    d = d - (m * (10 ^ i))
    Result = Result + R
    R = ""
Next i
con_2:


If p = 0 Then       ' rub
    Result = Result + "руб. "
End If

For i = 1 To 0 Step -1
    m = Int(e / (10 ^ i))
    Result = Result + Chr$(m + Asc("0"))
    e = e - (m * (10 ^ i))
Next i

If p = 0 Then       ' rub
    Result = Result + " коп."
Else                ' y.e.
    Result = Result + "/100 у.е"
End If

Digit2String = Result

End Function

Bezmen Nikolai wrote:
> 
> Может у кого есть макрос написания числа прописью?
> 
> Николай Безмен
----------- следущая часть -----------
Было удалено вложение не в текстовом формате...
Имя     : mikle.vcf
Тип     : text/x-vcard
Размер  : 460 байтов
Описание: Card for Mikhail Goussev
Url     : /pipermail/oo-discuss/attachments/20030324/a729cf58/mikle.vcf