Option Compare Database
'пример использования
Sub FDGSFG()
Debug.Print propiskop(12536.25)
End Sub
'
'ИСПОЛЬЗОВАТЬ ЭТУ ФУНКЦИЮ!!!
'
Function propiskop(num)
' Аргументы: положительное число < 1 000 000 000 000,457
' Назначение: преобразует это число в число прописью (с рублями и с копейками)
' Возвращает: строку, содержащую число прописью
' например propiskop(3000119,472) -> три миллиона сто девятнадцать рублей 47 копеек
' Вызывает: функции prop3(), prop3t(), prop3rub() и propkop()
' Вызов: propiskop()
' Составил: 4.07.96г., дописаны копейки 12.01.98г.
N = Int(((num - Int(num)) * 100) + 0.5) ' выделить копейки с правильным округлением
S = propkop(N) ' преобразовать копейки
N = Int(num) ' выделить рубли
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число
S = prop3rub(M) + S ' преобразовать младшие три цифры и приписать рублей/рубля/рубль
N = Int(num / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число тысяч
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "тысяча "
Case 2 To 4
L = "тысячи "
Case Else
L = "тысяч "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "тысяч "
End Select
S = prop3t(M) + L + S ' вызов prop3t для преобразования тысяч
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллион "
Case 2 To 4
L = "миллиона "
Case Else
L = "миллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллионов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллиардов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллиард "
Case 2 To 4
L = "миллиарда "
Case Else
L = "миллиардов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллиардов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллиардов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число триллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "триллион "
Case 2 To 4
L = "триллиона "
Case Else
L = "триллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "триллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования триллионов
End If
S = UCase(Mid(S, 1, 1)) + Mid(S, 2) ' первую букву сделать заглавной
propiskop = S
End Function
Function prop3(N)
' Аргументы: трехзначное целое положительное число
' Назначение: преобразует это число в число прописью
' Возвращает: строку, содержащую число прописью
' например prop3(119) -> сто девятнадцать
' Вызов: из функции propis()
' Составил: 2.07.96г.
S = ""
Select Case (N - 100 * Int(N / 100)) ' выделить две последние цифры
Case 10
S = "десять "
Case 11
S = "одинадцать "
Case 12
S = "двенадцать "
Case 13
S = "тринадцать "
Case 14
S = "четырнадцать "
Case 15
S = "пятнадцать "
Case 16
S = "шестнадцать "
Case 17
S = "семнадцать "
Case 18
S = "восемнадцать "
Case 19
S = "девятнадцать "
Case Else
i = 10 * Int(N / 10)
Select Case (N - i) ' выделить цифру единицы
Case 1
S = "один "
Case 2
S = "два "
Case 3
S = "три "
Case 4
S = "четыре "
Case 5
S = "пять "
Case 6
S = "шесть "
Case 7
S = "семь "
Case 8
S = "восемь "
Case 9
S = "девять "
End Select
SS = ""
i = i / 10
Select Case (i - 10 * Int(i / 10)) ' выделить цифру десятков
Case 2
SS = "двадцать "
Case 3
SS = "тридцать "
Case 4
SS = "сорок "
Case 5
SS = "пятьдесят "
Case 6
SS = "шестьдесят "
Case 7
SS = "семьдесят "
Case 8
SS = "восемьдесят "
Case 9
SS = "девяносто "
End Select
S = SS + S
End Select
SS = ""
Select Case Int(N / 100) ' выделить цифру сотен
Case 1
SS = "сто "
Case 2
SS = "двести "
Case 3
SS = "триста "
Case 4
SS = "четыреста "
Case 5
SS = "пятьсот "
Case 6
SS = "шестьсот "
Case 7
SS = "семьсот "
Case 8
SS = "восемьсот "
Case 9
SS = "девятьсот "
End Select
S = SS + S
prop3 = S
End Function
Function prop3rub(N)
' Аргументы: трехзначное целое положительное число
' Назначение: преобразует это число в число прописью с допиской рублей/рубля/рубль
' Возвращает: строку, содержащую число прописью
' например prop3rub(132) -> сто тридцать два рубля
' Вызов: из функции propis()
' Составил: 8.01.98г.
S = ""
Rub = "гривен "
Select Case (N - 100 * Int(N / 100)) ' выделить две последние цифры
Case 10
S = "десять " + Rub
Case 11
S = "одинадцать " + Rub
Case 12
S = "двенадцать " + Rub
Case 13
S = "тринадцать " + Rub
Case 14
S = "четырнадцать " + Rub
Case 15
S = "пятнадцать " + Rub
Case 16
S = "шестнадцать " + Rub
Case 17
S = "семнадцать " + Rub
Case 18
S = "восемнадцать " + Rub
Case 19
S = "девятнадцать " + Rub
Case Else
i = 10 * Int(N / 10)
Select Case (N - i) ' выделить цифру единицы
Case 0
S = Rub
Case 1
S = "одна гривна "
Case 2
S = "две гривны "
Case 3
S = "три гривны "
Case 4
S = "четыре гривны "
Case 5
S = "пять " + Rub
Case 6
S = "шесть " + Rub
Case 7
S = "семь " + Rub
Case 8
S = "восемь " + Rub
Case 9
S = "девять " + Rub
End Select
SS = ""
i = i / 10
Select Case (i - 10 * Int(i / 10)) ' выделить цифру десятков
Case 2
SS = "двадцать "
Case 3
SS = "тридцать "
Case 4
SS = "сорок "
Case 5
SS = "пятьдесят "
Case 6
SS = "шестьдесят "
Case 7
SS = "семьдесят "
Case 8
SS = "восемьдесят "
Case 9
SS = "девяносто "
End Select
S = SS + S
End Select
SS = ""
Select Case Int(N / 100) ' выделить цифру сотен
Case 1
SS = "сто "
Case 2
SS = "двести "
Case 3
SS = "триста "
Case 4
SS = "четыреста "
Case 5
SS = "пятьсот "
Case 6
SS = "шестьсот "
Case 7
SS = "семьсот "
Case 8
SS = "восемьсот "
Case 9
SS = "девятьсот "
End Select
S = SS + S
prop3rub = S
End Function
Function prop3t(N)
' Аргументы: трехзначное целое положительное число
' Назначение: преобразует это число в число прописью
' Возвращает: строку, содержащую число прописью
' например prop3е(101) -> сто одна (тысяча)
' например prop3е(102) -> сто две (тысячи)
' Вызов: из функции propis() для тысяч
' Составил: 2.07.96г.
S = ""
Select Case (N - 100 * Int(N / 100)) ' выделить две последние цифры
Case 10
S = "десять "
Case 11
S = "одинадцать "
Case 12
S = "двенадцать "
Case 13
S = "тринадцать "
Case 14
S = "четырнадцать "
Case 15
S = "пятнадцать "
Case 16
S = "шестнадцать "
Case 17
S = "семнадцать "
Case 18
S = "восемнадцать "
Case 19
S = "девятнадцать "
Case Else
i = 10 * Int(N / 10)
Select Case (N - i) ' выделить цифру единицы
Case 1
S = "одна "
Case 2
S = "две "
Case 3
S = "три "
Case 4
S = "четыре "
Case 5
S = "пять "
Case 6
S = "шесть "
Case 7
S = "семь "
Case 8
S = "восемь "
Case 9
S = "девять "
End Select
SS = ""
i = i / 10
Select Case (i - 10 * Int(i / 10)) ' выделить цифру десятков
Case 2
SS = "двадцать "
Case 3
SS = "тридцать "
Case 4
SS = "сорок "
Case 5
SS = "пятьдесят "
Case 6
SS = "шестьдесят "
Case 7
SS = "семьдесят "
Case 8
SS = "восемьдесят "
Case 9
SS = "девяносто "
End Select
S = SS + S
End Select
SS = ""
Select Case Int(N / 100) ' выделить цифру сотен
Case 1
SS = "сто "
Case 2
SS = "двести "
Case 3
SS = "триста "
Case 4
SS = "четыреста "
Case 5
SS = "пятьсот "
Case 6
SS = "шестьсот "
Case 7
SS = "семьсот "
Case 8
SS = "восемьсот "
Case 9
SS = "девятьсот "
End Select
S = SS + S
prop3t = S
End Function
Function propis(num)
' Аргументы: целое положительное число < 1 000 000 000 000
' Назначение: преобразует это число в число прописью (с рублями)
' Возвращает: строку, содержащую число прописью
' например propis(3000119) -> три миллиона сто девятнадцать рублей
' Вызывает: функции prop3(), prop3t() и prop3rub()
' Вызов: propis()
' Составил: 4.07.96г.
N = Int(num + 0.5) ' для правильного округления
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число
S = prop3rub(M) ' преобразовать младшие три цифры и приписать рублей/рубля/рубль
N = Int(num / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число тысяч
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "тысяча "
Case 2 To 4
L = "тысячи "
Case Else
L = "тысяч "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "тысяч "
End Select
S = prop3t(M) + L + S ' вызов prop3t для преобразования тысяч
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллион "
Case 2 To 4
L = "миллиона "
Case Else
L = "миллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллионов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллиардов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллиард "
Case 2 To 4
L = "миллиарда "
Case Else
L = "миллиардов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллиардов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллиардов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число триллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "триллион "
Case 2 To 4
L = "триллиона "
Case Else
L = "триллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "триллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования триллионов
End If
S = UCase(Mid(S, 1, 1)) + Mid(S, 2) ' первую букву сделать заглавной
propis = S
End Function
Function propisd(num)
' Аргументы: целое положительное число < 1 000 000 000 000
' Назначение: преобразует это число в число прописью (без копеек)
' Возвращает: строку, содержащую число прописью
' например propisd(3000119) -> три миллиона сто девятнадцать
' Вызывает: функции prop3() и prop3t()
' Вызов: propisd()
' Составил: 4.07.96г.
N = Int(num + 0.5) ' для правильного округления
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число
S = prop3(M) ' преобразовать младшие три цифры
N = Int(num / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число тысяч
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "тысяча "
Case 2 To 4
L = "тысячи "
Case Else
L = "тысяч "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "тысяч "
End Select
S = prop3t(M) + L + S ' вызов prop3t для преобразования тысяч
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллион "
Case 2 To 4
L = "миллиона "
Case Else
L = "миллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллионов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число миллиардов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "миллиард "
Case 2 To 4
L = "миллиарда "
Case Else
L = "миллиардов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "миллиардов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования миллиардов
End If
N = Int(N / 1000) ' отбросить три последние цифры
M = N - 1000 * Int(N / 1000) ' выделить трехзначное число триллионов
L = ""
If M > 0 Then
Select Case (M - 10 * Int(M / 10))
Case 1
L = "триллион "
Case 2 To 4
L = "триллиона "
Case Else
L = "триллионов "
End Select
Select Case (M - 100 * Int(M / 100)) ' поправка для 11,12,13,14
Case 11 To 14
L = "триллионов "
End Select
S = prop3(M) + L + S ' вызов prop3 для преобразования триллионов
End If
S = UCase(Mid(S, 1, 1)) + Mid(S, 2) ' первую букву сделать заглавной
propisd = S
End Function
Function propkop(N)
' Аргументы: двухзначное целое положительное число
' Назначение: преобразует это число в число с допиской копеек/копейки/копейка
' Возвращает: строку, содержащую число прописью
' например propkop(32) -> 32 копейки
' Вызов: из функции propiskop()
' Составил: 12.01.98г.
S = " копеек"
If N < 10 Or N > 19 Then
i = 10 * Int(N / 10)
Select Case (N - i) ' выделить цифру единицы
Case 1
S = " копейка"
Case 2 To 4
S = " копейки"
End Select
End If
If N > 9 Then
propkop = Str$(N) + S
Else
propkop = "0" + Mid(Str$(N), 2) + S
End If
End Function
