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

 

Hosted by uCoz