Функция 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
|