Функция LetterSum является дополнением к функции IntTxt.
Печатает названия денежных единиц.

Function LetterSum(sum As Currency) As String

Dim R As Long, K As Integer, tmp As Integer

Dim Z As String, ZR As String, ZK As String

Const RKdiv = "  "

R = Int(sum)

K = (sum - R) * 100

ZR = IntTxt(R) + " " + DTxt(R, "рубль", "рубля", "рублей")

ZK = Format$(K, "00") + " " + DTxt(K, "копейка", "копейки", "копеек")

Z = ZR & RKdiv & ZK

Z = UCase$(Mid$(Z, 1, 1)) + Mid$(Z, 2)

LetterSum = Z

End Function

------------------------------------------------------------------------------------

Function DTxt(Number As Variant, W0 As String, W1 As String, W2 As String) As String

Dim tmp As String, Z As Integer

tmp = Trim$(Str$(Number))

Z = Val(Right$(tmp, 2))

If Z < 20 Then

    Select Case Z

      Case 0, 5 To 19

        tmp = W2

      Case 1

        tmp = W0

      Case 2, 3, 4

        tmp = W1

    End Select

  Else

    Select Case (Z - 10 * Int(Z / 10))

      Case 0, 5 To 9

        tmp = W2

      Case 1

        tmp = W0

      Case 2, 3, 4

        tmp = W1

    End Select

End If

DTxt = tmp

End Function


 

к оглавлению
Используются технологии uCoz