|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Лет 5 назад срочно понадобилась такая функция, по-быстрому сваял:
Public Function funDateText(datDate As Date) As String
Dim varDay As Variant
Dim varMonth As Variant
Dim varYear As Variant
Dim intYear As Integer
Const conYear As String = "две тысячи "
intYear = Year(datDate)
Select Case intYear
Case 2001 To 2020
funDateText = ""
varDay = Array("", "Первое ", "Второе ", "Третье ", "Четвертое ", "Пятое ", "Шестое ", "Седьмое ", _
"Восьмое ", "Девятое ", "Десятое ", "Одиннадцатое ", "Двеннадцатое ", _
"Тринадцатое ", "Четырнадцатое ", "Пятнадцатое ", "Шестнадцатое ", "Семнадцатое ", _
"Восемнадцатое ", "Девятнадцатое ", "Двадцатое ", "Двадцать первое ", _
"Двадцать второе ", "Двадцать третье ", "Двадцать четвертое ", "Двадцать пятое ", _
"Двадцать шестое ", "Двадцать седьмое ", "Двадцать восьмое ", "Двадцать девятое ", _
"Тридцатое ", "Тридцать первое ")
varMonth = Array("", "января ", "февраля ", "марта ", "апреля ", "мая ", "июня ", "июля ", "августа ", _
"сентября ", "октября ", "ноября ", "декабря ")
varYear = Array("", "первого ", "второго ", "третьего ", "четвертого ", "пятого ", "шестого ", _
"седьмого ", "восьмого ", "девятого ", "десятого ", "одиннадцатого ", "двенадцатого ", _
"тринадцатого ", "четырнадцатого ", "пятнадцатого ", "шестнадцатого ", "семнадцатого ", _
"восемнадцатого ", "девятнадцатого ", "двадцатого ")
funDateText = varDay(Day(datDate)) & varMonth(Month(datDate)) & conYear & varYear(intYear - 2000) & "года"
Case Else
funDateText = "Дата вне интервала функции"
End Select
End Function
|
Может кому попадалось более красивое решение? | |
| |
| |
| |
|
|
| | может вот это?
Function MESDate(MyMES As Variant) As String
Dim MyMonth As String
Dim MyMonthNom As Integer
'If Not IsMONTH(MyMES) Then MESDate = " ": Exit Function
On Error GoTo MESDate_Error
'-------------------------------------------------------------------------------
MyMonthNom = MyMES
Select Case MyMonthNom
Case 1: MyMonth = " Январь "
Case 2: MyMonth = " Февраль "
Case 3: MyMonth = " Март "
Case 4: MyMonth = " Апрель "
Case 5: MyMonth = " Май "
Case 6: MyMonth = " Июнь "
Case 7: MyMonth = " Июль "
Case 8: MyMonth = " Август "
Case 9: MyMonth = " Сентябрь "
Case 10: MyMonth = " Октябрь "
Case 11: MyMonth = " Ноябрь "
Case 12: MyMonth = " Декабрь "
End Select
MESDate = MyMonth & " месяц. "
'-------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
MESDate_Error:
Call Zapis_ERR("Dat_MOD" & "процедура->" & "MESDate", Err.Number, Err.Description)
MESDate = " "
End Function
|
| |
| |
| |
| |
|
|
| | Ой нет не то
Function jsDocDate(MyDate As Variant) As String
Dim MyMonth As String
Dim MyMonthNom As Integer
'-------------------------------------------------------------------------------
On Error GoTo jsDocDateErr
If Not IsDate(MyDate) Then jsDocDate = Chr$(171) & "_____" & Chr$(187) & "_________________ 20___ г.": Exit Function
MyMonthNom = Month(MyDate)
Select Case MyMonthNom
Case 1: MyMonth = " января "
Case 2: MyMonth = " февраля "
Case 3: MyMonth = " марта "
Case 4: MyMonth = " апреля "
Case 5: MyMonth = " мая "
Case 6: MyMonth = " июня "
Case 7: MyMonth = " июля "
Case 8: MyMonth = " августа "
Case 9: MyMonth = " сентября "
Case 10: MyMonth = " октября "
Case 11: MyMonth = " ноября "
Case 12: MyMonth = " декабря "
End Select
jsDocDate = Chr(171) & Format(Day(MyDate), "00") & Chr(187) & _
MyMonth & Year(MyDate) & "г."
Exit Function
jsDocDateErr:
jsDocDate = ""
'-------------------------------------------------------------------------------
End Function
|
А число прописью | |
| |
| |
| |
|
|
| | Опять не то.  | |
| |
| |
| |
|
|
| | тебе просто число - прописью надо - да? | |
| |
| |
| |
|
|
| |
Public e(10)
Public de(10)
Public d(10)
Public s(10)
Public t(10)
Public dt(10)
Public dtt(10)
Public st(10)
Public mil(10)
Public dmil(10)
Public m(10): Public sk: Public zn: Public DL: Public hislo
Public mn As Integer
Function обраб()
'================== Сумма прописью ==========================================
'Это я сам насочинял вроде работает
If DL = 1 Then sk = Right(hislo, 1): один
If DL = 2 And Mid(hislo, 1, 1) = "1" Then sk = Mid(hislo, 2, 1): два
If DL = 2 And Mid(hislo, 1, 1) = "0" Then sk = Mid(hislo, 2, 1): один
If DL = 2 And Val(Mid(hislo, 1, 1)) > 1 Then sk = Mid(hislo, 1, 1): дес
If DL = 3 Then sk = Mid(hislo, 1, 1): сот
If DL = 4 Then sk = Mid(hislo, 1, 1): тыс
If DL = 5 And (Mid(hislo, 1, 1)) = "1" Then sk = Mid(hislo, 2, 1): тыся
If DL = 5 And Val(Mid(hislo, 1, 1)) > 1 Then sk = Mid(hislo, 1, 1): дтыс
If DL = 5 And Mid(hislo, 1, 1) = "0" Then sk = Mid(hislo, 1, 1): дтыс
If DL = 6 And Mid(hislo, 1, 1) = "1" Then sk = Mid(hislo, 1, 1): Стыс
If DL = 6 And Val(Mid(hislo, 1, 1)) > 1 Then sk = Mid(hislo, 1, 1): Стыс
If DL = 6 And Mid(hislo, 1, 1) = "0" Then sk = Mid(hislo, 1, 1): Стыс
If DL = 7 And Mid(hislo, 1, 1) = "1" Then sk = Mid(hislo, 1, 1): милл
If DL = 7 And Val(Mid(hislo, 1, 1)) > 1 Then sk = Mid(hislo, 1, 1): милл
If DL = 8 And Val(Mid(hislo, 2, 1)) > 1 Then sk = Mid(hislo, 2, 1): дмилл
If DL = 8 And (Mid(hislo, 2, 1)) = "0" Then sk = Mid(hislo, 2, 1): дмилл
End Function
Function один()
zn = zn & " " & e(sk)
End Function
Function два()
zn = zn & " " & de(sk)
End Function
Function дес()
zn = zn & " " & d(sk)
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function сот()
zn = zn & " " & s(sk)
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function тыс()
zn = zn & " " & t(sk)
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function тыся()
zn = zn & " " & dt(sk)
DL = DL - 2
hislo = Right(hislo, DL)
обраб
End Function
Function дтыс()
zn = zn & " " & dtt(sk)
If InStr(1, zn, "миллион") = 0 And Mid(hislo, 2, 1) = "0" Then zn = zn & " тысяч"
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function Стыс()
zn = zn & " " & st(sk)
If InStr(1, zn, "миллион") <> 0 And Mid(hislo, 2, 1) = "0" Then zn = zn & " тысяч"
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function милл()
zn = zn & " " & mil(sk)
DL = DL - 1
hislo = Right(hislo, DL)
обраб
End Function
Function дмилл()
zn = zn & " " & dmil(sk)
DL = DL - 2
hislo = Right(hislo, DL)
обраб
End Function
может из этого можно вырезать - без миллионов.....
|
| |
| |
| |
| |
|
|
| | Дык у тебя лучшее будет, чё ты её не любишь-то? | |
| |
| |
| |
|
|
| | Ограниченный интервал 2001-2020 годами. А если понадобится 1999 г.? | |
| |
| |
| |
|
|
| | тада скрещивай - будет любой интервал.............  | |
| |
| |
| |
|
|
| | тебе просто число - прописью надо - да?
Нет. Дату полностью прописью. | |
| |
| |
| |
|
|
| | тада у тебя - самая лучшая функца........
а то придётся две скрещивать. | |
| |
| |
| |
|
|
| | Прекрассная функция тока varYear
Надо функцу добавить число прописью
и вот это убрать funDateText = "Дата вне интервала функции"
И красотыща....  | |
| |
| |
| |
|
|
| | ползовать
Me.дата = Date
DoCmd.Maximize
e(1) = "один"
e(2) = "два"
e(3) = "три"
e(4) = "четыре"
e(5) = "пять"
e(6) = "шесть"
e(7) = "семь"
e(8) = "восемь"
e(9) = "девять"
de(0) = "десять"
de(1) = "одиннадцать"
de(2) = "двенадцать"
de(3) = "тринадцать"
de(4) = "четырнадцать"
de(5) = "пятнадцать"
de(6) = "шестнадцать"
de(7) = "семнадцать"
de(8) = "восемнадцать"
de(9) = "девятнадцать"
d(2) = "двадцать"
d(3) = "тридцать"
d(4) = "сорок"
d(5) = "пятьдесят"
d(6) = "шестьдесят"
d(7) = "семьдесят"
d(8) = "восемьдесят"
d(9) = "девяносто"
s(1) = "сто"
s(2) = "двести"
s(3) = "триста"
s(4) = "четыреста"
s(5) = "пятьсот"
s(6) = "шестьсот"
s(7) = "семьсот"
s(8) = "восемьсот"
s(9) = "девятьсот"
t(1) = "одна тысяча"
t(2) = "две тысячи"
t(3) = "три тысячи"
t(4) = "четыре тысячи"
t(5) = "пять тысяч"
t(6) = "шесть тысяч"
t(7) = "семь тысяч"
t(8) = "восемь тысяч"
t(9) = "девять тысяч"
dt(0) = "десять тысяч"
dt(1) = "одиннадцать тысяч"
dt(2) = "двенадцать тысяч"
dt(3) = "тринадцать тысяч"
dt(4) = "четырнадцать тысяч"
dt(5) = "пятнадцать тысяч"
dt(6) = "шестнадцать тысяч"
dt(7) = "семнадцать тысяч"
dt(8) = "восемнадцать тысяч"
dt(9) = "девятнадцать тысяч"
dtt(2) = "двадцать"
dtt(3) = "тридцать"
dtt(4) = "сорок"
dtt(5) = "пятьдесят"
dtt(6) = "шестьдесят"
dtt(7) = "семьдесят"
dtt(8) = "восемьдесят"
dtt(9) = "девяносто"
st(1) = "сто"
st(2) = "двести"
st(3) = "триста"
st(4) = "четыреста"
st(5) = "пятьсот"
st(6) = "шестьсот"
st(7) = "семьсот"
st(8) = "восемьсот"
st(9) = "девятьсот"
mil(1) = "один миллион"
mil(2) = "два миллиона"
mil(3) = "три миллиона"
mil(4) = "четыре миллиона"
mil(5) = "пять миллионов"
mil(6) = "шесть миллионов"
mil(7) = "семь миллионов"
mil(8) = "восемь миллионов"
mil(9) = "девять миллионов"
dmil(0) = "десять миллионов"
dmil(1) = "одиннадцать миллионов"
dmil(2) = "двенадцать миллионов"
dmil(3) = "тринадцать миллионов"
dmil(4) = "четырнадцать миллионов"
dmil(5) = "пятнадцать миллионов"
dmil(6) = "шестнадцать миллионов"
dmil(7) = "семнадцать миллионов"
dmil(8) = "восемнадцать миллионов"
dmil(9) = "девятнадцать миллионов"
End Sub
|
| |
| |
| |
| |
|
|
| |
а то придётся две скрещивать.
|
Лысенки с Вавиловыми и Мичуриными отдыхают после таких срещиваний :))) | |
| |
| | |
| |
|
| |
|
|
| | Этот код хотел в отладчике глянуть, точек останова штук десять понатыкал, а прога работает и певать хотела на эти точки...... 
Крутая прога получилась - фиг вскроешь......... | |
| |
| |
HiProg.com - Технологии программирования
|
