archimed7592
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Tushkanchyk,
Код: Attribute VB_Name = "Module1"
Function Suma_Litere(sc)
On Error GoTo Err_Suma_Litere
' Функция возвращает сумму прописью
' на русском языке
' для подключеничя макроса выберите пунк сервис/макрос/редактор Visual Basic
' File/Import
' 20.02.2001 Басистый В.И.
'
Dim adec As Variant
Dim rez As String, k As String, Kop As String, a1 As String, a As String
Dim pz As Integer, ad As Integer, ae As Integer
ReDim zeci(90) As String, sut(9) As String, o(5, 2) As String
ReDim M(4) As Double, z(4) As Double, S(4) As Double
zeci(1) = "один"
zeci(2) = "два"
zeci(3) = "три"
zeci(4) = "четыре"
zeci(5) = "пять"
zeci(6) = "шесть"
zeci(7) = "семь"
zeci(8) = "восемь"
zeci(9) = "девять"
zeci(10) = "десять"
zeci(11) = "одинадцать"
zeci(12) = "двенадцать"
zeci(13) = "тринадцать"
zeci(14) = "четырнадцать"
zeci(15) = "пятнадцать"
zeci(16) = "шестнадцать"
zeci(17) = "семнадцать"
zeci(18) = "восемнадцать"
zeci(19) = "девятнадцать"
zeci(20) = "двадцать"
zeci(30) = "тридцать"
zeci(40) = "сорок"
zeci(50) = "пятьдесят"
zeci(60) = "шестьдесят"
zeci(70) = "семьдесят"
zeci(80) = "восемьдесят"
zeci(90) = "девяносто"
sut(1) = "сто"
sut(2) = "двести"
sut(3) = "триста"
sut(4) = "четыреста"
sut(5) = "пятьсот"
sut(6) = "шестьсот"
sut(7) = "семьсот"
sut(8) = "восемьсот"
sut(9) = "девятьсот"
o(1, 1) = "миллиардов"
o(1, 2) = "миллиард"
o(2, 1) = "миллионов"
o(2, 2) = "миллион"
o(3, 1) = "тысячи"
o(3, 2) = "тысяча"
o(4, 1) = "лея"
o(4, 2) = "лей"
'sc = Forms!Form_oi!valoarea
adec = 100000000000000# + (sc * 100)
a1 = adec
a = Mid(a1, 2)
M(1) = Mid(a, 1, 3)
z(1) = Mid(a, 2, 2)
S(1) = Mid(a, 1, 1)
M(2) = Mid(a, 4, 3)
z(2) = Mid(a, 5, 2)
S(2) = Mid(a, 4, 1)
M(3) = Mid(a, 7, 3)
z(3) = Mid(a, 8, 2)
S(3) = Mid(a, 7, 1)
M(4) = Mid(a, 10, 3)
z(4) = Mid(a, 11, 2)
S(4) = Mid(a, 10, 1)
k = Mid(a, 13, 2)
rez = " "
For pz = 1 To 4
If M(pz) > 1 Then
zeci(1) = "один"
ElseIf pz = 3 Then
zeci(1) = "одна"
End If
If pz < 4 Then
zeci(2) = "два"
End If
If S(pz) > 0 Then
rez = rez & sut(S(pz)) & " "
End If
If z(pz) > 0 Then
If z(pz) < 20 Then
rez = rez & zeci(z(pz)) & " "
Else
ae = z(pz) Mod 10
ad = z(pz) - ae
rez = rez & zeci(ad) & " "
If ae > 0 Then
rez = rez & Trim(zeci(ae)) & " "
End If
End If
End If
If M(pz) > 0 Then
If M(pz) = 1 Then
rez = rez & Trim(o(pz, 2)) & " "
Else
rez = rez & Trim(o(pz, 1)) & " "
End If
End If
zeci(1) = "один"
zeci(2) = "два"
Next
If M(1) + M(2) + M(3) + M(4) = 0 Then
rez = rez & "ноль лей"
Else
If M(4) = 0 Then
rez = rez & "лей"
End If
End If
sc = Mid(rez, 2)
' If Val(k) <> 0 Then
sc = sc & " " & k & " " & "бань"
' End If
Suma_Litere = UCase(Left(sc, 1)) & Mid(sc, 2, Len(sc))
Exit_Suma_Litere:
Exit Function
Err_Suma_Litere:
'Result = ErrorHandler(Err)
Resume Exit_Suma_Litere
End Function
Sub SumLiter()
Attribute SumLiter.VB_Description = "Возвращает сумму прописью"
Attribute SumLiter.VB_ProcData.VB_Invoke_Func = "l\n14"
Suma_Litere (sc)
End Sub |
или Microsoft Office Extensions -> Программы для представления числа прописью на русском языке |
