Option Explicit
Function MSumPropUkr$(chislo#) 'Автор MCH (Михаил Ч.), май 2012
    Dim rub$, kop$, ed, des, sot, nadc, razr, i&, m$
    If chislo >= 1E+15 Or chislo < 0 Then Exit Function

    sot = Array("", "сто ", "двісті ", "триста ", "чотириста ", "п'ятсот ", "шістсот ", "сімсот ", "вісімсот ", "дев'ятсот ")
    des = Array("", "", "двадцять ", "тридцять ", "сорок ", "п'ятдесят ", "шістдесят ", "сімдесят ", "вісімдесят ", "дев'яносто ")
    nadc = Array("десять ", "одинадцять ", "дванадцять ", "тринадцять ", "чотирнадцять ", "п'ятнадцять ", "шістнадцять ", "сімнадцять ", "вісімнадцять ", "дев'ятнадцять ")
    ed = Array("", "один ", "два ", "три ", "чотири ", "п'ять ", "шість ", "сім ", "вісім ", "дев'ять ", "", "одна ", "дві ")
    razr = Array("трильйон ", "трильйона ", "трильйонів ", "мільярд ", "мільярда ", "мільярдів ", "мільйон ", "мільйона ", "мільйонів ", "тисяча ", "тисячі ", "тисяч ", "гривня ", "гривні ", "гривень ")
     
    rub = Left(Format(chislo, "000000000000000.00"), 15)
    kop = Right(Format(chislo, "0.00"), 2)
     
    If CDbl(rub) = 0 Then
        m = "нуль " & razr(UBound(razr))
    Else
        For i = 1 To Len(rub) - 6 Step 3
            If Mid(rub, i, 3) <> "000" Then
                m = m & sot(CInt(Mid(rub, i, 1)))
                Select Case Mid(rub, i + 1, 1)
                   Case "1"
                      m = m & nadc(CInt(Mid(rub, i + 2, 1))) & razr(i + 1)
                   Case Else
                      m = m & des(CInt(Mid(rub, i + 1, 1))) & ed(CInt(Mid(rub, i + 2, 1)))
                      Select Case Mid(rub, i + 2, 1)
                      Case "1"
                          m = m & razr(i - 1)
                      Case "2", "3", "4"
                          m = m & razr(i)
                      Case Else
                          m = m & razr(i + 1)
                      End Select
                End Select
            End If
        Next i
        For i = Len(rub) - 5 To Len(rub) Step 3
            If Mid(rub, i, 3) <> "000" Then
                m = m & sot(CInt(Mid(rub, i, 1)))
                Select Case Mid(rub, i + 1, 1)
                    Case "1"
                        m = m & nadc(CInt(Mid(rub, i + 2, 1))) & razr(i + 1)
                    Case Else
                        m = m & des(CInt(Mid(rub, i + 1, 1)))
                        Select Case Mid(rub, i + 2, 1)
                        Case "1"
                            m = m & ed(11) & razr(i - 1)
                        Case "2"
                            m = m & ed(12) & razr(i)
                        Case "3", "4"
                            m = m & ed(CInt(Mid(rub, i + 2, 1))) & razr(i)
                        Case Else
                            m = m & ed(CInt(Mid(rub, i + 2, 1))) & razr(i + 1)
                        End Select
                End Select
            End If
        Next i
    End If
    m = m & kop & " копі"
    Select Case Left(kop, 1)
        Case "1"
            m = m & "йок"
        Case Else
            Select Case Mid(kop, 2)
                Case "1"
                    m = m & "йка"
                Case "2", "3", "4"
                    m = m & "йки"
                Case Else
                    m = m & "йок"
            End Select
    End Select
    MSumPropUkr = UCase(Left(m, 1)) & Mid(m, 2)
End Function