[oodisc] число_прописью

[Vlad Vasiliev]

В. Ефименко пишет:

>Уважаемые господа!
>Никто не может презентовать макрос (надстройку) для ООО "Число (сумма)
>прописью"?
>Буду весьма признателен.
>  
>
Этот макрос основан на функции написанной  Михаилом Гусевым.
Влад.
----------- УМЕДХЭБС ЮБУФШ -----------
REM  *****  BASIC  *****
 
Sub propis
Dim dd As Double
Dim st As String
	oSelect=ThisComponent.CurrentSelection.getRangeAddress
	oSelectColumn=ThisComponent.CurrentSelection.Columns
	oSelectRow=ThisComponent.CurrentSelection.Rows
	oSelectSC=oSelect.StartColumn
	oSelectSR=oSelect.StartRow
    oCell1=ActiveSheet.getCellByposition(oSelectSC,oSelectSR) 
'dd = 21.2234
dd=oCell1.getValue
' 0 - rub
' 1 - y.e.
st = Digit2String(dd, 0)
CellPos(oSelectSC,oSelectSR).setString(st)
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 -> 106
b = digit_long - (a * 1000000) '32123456-32000000 = 123456
c = Int(b / 1000) '123456/1000 = 123 -> 103
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

Function CellPos(lColumn As Long,lRow As Long)
	CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)
End Function

Function ActiveSheet
 	ActiveSheet=StarDesktop.CurrentComponent.CurrentController.ActiveSheet
End Function