Сумма прописью (Макрос)
Для тех кто знаечт, что такое "МАКРОС"
Сделать следующее: открыть файл (например платежное поручение) Excel, активизировать Visual Basik. Далее Insert - Module и скопировать нижеследующее. Сохранить. Эта будет в разряде МАСТЕРА ФУНКЦИЙ - Определенные пользователем - "funSupr"
Public Function funSupr(xsu As Currency, Optional mb As Byte) As String
' прописью в манатах по-русски
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
funSupr = ""
Exit Function
End If
If xsu >= 10000000000000# Then
funSupr = "мама-мийа"
Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
funSupr = "сыфр манат "
Else
ssu = Mid$(Str$(Fix(xsu)), 2)
nsu = (Len(ssu) + 2) 3
ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu
For i = nsu To 1 Step -1
sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1))
des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1))
edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1))
If sot + des + edi > 0 Or i = 1 Then
If sot > 0 Then
funSupr = funSupr + Choose(sot, "йцз", "ики йцз", "цч йцз", _
"дюрд йцз", "беш цйз", "алты йцз", "йедди йцз", "сяккиз йцз", _
"доггуз йцз") + " "
End If
If des = 1 Then
funSupr = funSupr + Choose(edi + 1, "он", "он бир", _
"он ики", "он цч", "он дюрд", "он беш", "он алты", _
"он йедди", "он сяккиз", "он доггуз") + " "
ind = 3
Else
If des <> 0 Then
funSupr = funSupr + Choose(des - 1, "ийирми", _
"отуз", "гырх", "ялли", "алтмыш", "йетмиш", "сяксяк", _
"дохсан") + " "
End If
If edi <> 0 Then
If i = 2 And (edi = 1 Or edi = 2) Then
ind = 9
Else
ind = 0
End If
funSupr = funSupr + Choose(edi + ind, "бир", "ики", _
"цч", "дюрд", "беш", "алты", "йедди", "сяккиз", "доггуз", "бир", _
"ики") + " "
End If
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + Choose((i - 1) * 3 + ind, "манат,", "манат,", _
"манат,", "мин", "мин", "мин", "милион", "милион", "милион", _
"милиард", "милиард", "милиард", "трилион", "трилион", _
"трилион") + " "
End If
Next i
End If
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If des = 1 Then
ind = 3
Else
Select Case edi
Case 1
ind = 1
Case 2, 3, 4
ind = 2
Case Else
ind = 3
End Select
End If
funSupr = funSupr + ssu + Choose(ind, " гяпик", " гяпик", " гяпик")
If mb = 0 Then
funSupr = UCase$(Left$(funSupr, 1)) + Mid$(funSupr, 2)
End If
Exit Function
ersupr:
funSupr = "упсссс"
End Function