|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Часто приходится работать с датами, и соответственно, так же часто возникает ряд вопросов, связанный с этими же датами.
Возникающие вопросы, которые смог придумать:
-вычисление разницы между 2 датами,
-сложение/вычитание какой либо даты определенного количества дней
-Проверка "високосности года"
-преобразование разницы дат в формат вида 2 года 6 мес. 5 дней
-вычисление даты опережающей/отстающей от сегодняшней на какое либо количество дней
-Преобразование дат из одного формата в другой
-Преобразование дат к какому либо формату
Да, так вот к чему весь этот поток сознания: Существует куча функций, позволяющих решить каждый из этих вопросов. Но каждый раз их приходится писать заново, вот я и хочу создать пользовательский класс,объединив эти фукции, позволяющий решать эти вопросы. Его проще вставить в модуль акса и работать как с обычным классом.
Так вот, народ, плиз напишите кто с какими вопросами при работе с датами сталкивался и какие еще вопросы могут быть. Их тоже можно описать в этом классе.
Бысторого решения не обещаю, но если получится, выложу сюда, авось кому и сгодится. | |
| |
| |
| |
|
|
| | Спасибо тебе формат за энтузиазм
вот посмотри
http://hiprog.com/forum/read.php?id_forum=1&id_theme=3806&page=1
А если коротко:
Recordset Не видит полей на форме, а там даты в том числе.
Даты в запросе просят английского формата или ## | |
| |
| |
| |
|
|
| | 1. Наверное стоит включить проверку на пересечение интервалов дат, и на вхождение одного интервала в другой полностью.
2. Определение дат начала и конца недели для заданной даты. | |
| |
| |
| |
|
|
| | в помощь
http://hiprog.com/index.php?option=com_content&task=view&id=396
http://hiprog.com/index.php?option=com_content&task=view&id=280
http://hiprog.com/index.php?option=com_content&task=view&id=163
http://hiprog.com/index.php?option=com_content&task=view&id=134 | |
| |
| |
| |
|
|
| | osmor!
Большое спасибо за ссылки. Они, практически, решают проблему. | |
| |
| |
| |
|
|
| | Вообще хорошая затея
а к датам я бы еще и работу со времнем добавил
FORMAT - еще свежие идеи можно с NET почерпнуть, там много чего с датами и временем можно делать | |
| |
| |
| |
 22 Кб. |
|
| | Наконец то дошли руки до класса.
Вот сам класс и его описание.
Там порядка 10 функций. Его не тестириовал, так, что если будут глюки - пишите какие. исправим. В принципе расширить его можно. | |
| |
| |
| |
2 Кб. |
|
| | описание класса | |
| |
| |
| |
|
|
| | Пока не тестировал, но FORMAT _МОЛОДЕЦ!
Обещал, - получите......... | |
| |
| |
| |
|
|
| | При компилировании сразу всплыло:
Public Function IsIntervalCrossing(dtBeginDateFirstInterval, dtEndDateFirstInterval, dtBeginDateSecondInterval, dtEndDateSecondInterval) As Boolean
If .... Then
IsIntervalCrossing = True ' здесь я подправил
Else
IsIntervalCrossing = False ' здесь я подправил
End If
End Function
|
И попутно вопрос:
Оформление в виде класса не позволяет использовать функции в сохраненных запросах, или я не умею это делать? | |
| |
| |
| |
|
|
| | И еще возник вопрос:
Для чего объявлены переменные типа Date в области объявления переменных модуля класса? | |
| |
| |
| |
|
|
| | Для того, чтобы каждый раз в функциях не указывать тип переменной "as date" | |
| |
| |
| |
|
|
| | Интересно, не знал что так можно.  | |
| |
| |
| |
22 Кб. |
|
| | Позволил себе некоторую вольность, переписал несколько иначе класс, предложенный FORMATом.
В файле обе версии.
В модуле1 функция тестирования класса clsDate. | |
| |
| |
| |
|
|
| | Интересно, а можно-ли использовать для определения високосного года такую функцию:
Public Function funIsLeapYear(dtDate As Date) As Boolean
funIsLeapYear = ((year(dtDate) Mod 4) = 0)
End Function
|
 | |
| |
| |
| |
|
|
| | такую функцию использовать нельзя, т.к. не все високосные года те, что кратны 4.
например 1900 год кратен 4, но он не високосный. | |
| |
| |
| |
|
|
| | Чувствовал, что где-то подвох.
Что за дискриминация такая?  | |
| |
| |
| |
25 Кб. |
|
| | Вариант №2.
Добавил функции квартала. | |
| |
| |
| |
|
|
| | Мне вариант Lukasa нравится больше. | |
| |
| | |
|
| |
|
|
| | а вот мне попалось - добрый человек делал - может добавить.....
Входная короткая дата, а на выходе сколько прошло времени.
Function MyDateDiff(ByVal D1 As Date, D2 As Date) As String
Dim Y As Integer, M As Integer, D As Integer
Y = DateDiff("YYYY", D1, D2)
If DateAdd("YYYY", Y, D1) > D2 Then Y = Y - 1
D1 = DateAdd("YYYY", Y, D1)
M = DateDiff("M", D1, D2)
If DateAdd("M", M, D1) > D2 Then M = M - 1
D1 = DateAdd("M", M, D1)
D = DateDiff("D", D1, D2)
MyDateDiff = Y & " лет, " & M & " месяцев, " & D & " дней"
End Function
|
| |
| |
| |
| |
|
|
| | И вот ещё от Матющенко:
Совет:
'Примечание:
'если в качестве входного параметра указано (Optional dteDate As Date),
'то вызов функции можно осуществлять как НазваниеФункции()
'- то есть можно оставлять пустые скобки.
'Например:
'MsgBox FirstOfQuarter()
--------------------------------------------------------------------------------
' определение первого дня месяца
Function FirstOfMonth(Optional dteDate As Date) As Date
'если параметр dteDate = 0 то для вычисления берется текущая дата
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfMonth = DateSerial(Year(dteDate), Month(dteDate), 1)
MsgBox "Первый день месяца - " & FirstOfMonth
End Function
--------------------------------------------------------------------------------
Function LastOfMonth(Optional dteDate As Date) As Date
'если параметр dteDate = 0 то для вычисления берется текущая дата
If CLng(dteDate) = 0 Then
dteDate = Date
End If
'Ищется первый день следующего месяца, и вычитается один день
LastOfMonth = DateSerial(Year(dteDate), Month(dteDate) + 1, 1) - 1
MsgBox "Первый день месяца - " & LastOfMonth
End Function
--------------------------------------------------------------------------------
' определение первого дня месяца предыдущего указанному
Function FirstOfPreviousMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfPreviousMonth = DateSerial(Year(dteDate), Month(dteDate) - 1, 1)
MsgBox "Первый день предыдущего месяца - " & FirstOfPreviousMonth
End Function
--------------------------------------------------------------------------------
' определение последнего дня месяца предыдущего указанному
Function LastOfPreviousMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfPreviousMonth = DateSerial(Year(dteDate), Month(dteDate), 0)
MsgBox "Последний день предыдущего месяца - " & LastOfPreviousMonth
End Function
--------------------------------------------------------------------------------
' определение первого дня месяца следующего за указанным
Function FirstOfNextMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfNextMonth = DateSerial(Year(dteDate), Month(dteDate) + 1, 1)
MsgBox "Первый день следующего месяца - " & FirstOfNextMonth
End Function
--------------------------------------------------------------------------------
' определение последнего дня месяца следующего за указанным
Function LastOfNextMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfNextMonth = DateSerial(Year(dteDate), Month(dteDate) + 2, 0)
MsgBox "Последний день следующего месяца - " & LastOfNextMonth
End Function
--------------------------------------------------------------------------------
'Определение первого дня текущего квартала
Function FirstOfQuarter(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfQuarter = DateSerial(Year(dteDate), Int((Month(dteDate) - 1) / 3) * 3 + 1, 1)
MsgBox "Первый день текущего квартала - " & FirstOfQuarter
End Function
--------------------------------------------------------------------------------
'Определение последнего дня текущего квартала
Function LastOfQuarter(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfQuarter = DateSerial(Year(dteDate), Int((Month(dteDate) - 1) / 3) * 3 + 4, 0)
MsgBox "Последний день текущего квартала - " & LastOfQuarter
End Function
--------------------------------------------------------------------------------
Function FirstOfPolugod(Optional dteDate As Date) As Date
'Dim dteDate As Date
'dteDate = #12/15/02#
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfPolugod = DateSerial(Year(dteDate), Int((Month(dteDate) - 1) / 6) * 6 + 1, 1)
MsgBox "Первый день текущего полугодия - " & FirstOfPolugod
End Function
--------------------------------------------------------------------------------
Function LastOfPolugod(Optional dteDate As Date) As Date
'Dim dteDate As Date
'dteDate = #12/15/02#
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfPolugod = DateSerial(Year(dteDate), Int((Month(dteDate) - 1) / 6) * 6 + 7, 0)
MsgBox "Первый день текущего полугодия - " & LastOfPolugod
End Function
--------------------------------------------------------------------------------
' Первый день недели
Function StartOfWeek(Optional D As Variant) As Variant '
Dim FirstWeekday As Integer
FirstWeekday = 2
If IsMissing(D) Then 'Первый день недели - понедельник
D = Date
StartOfWeek = D - WeekDay(D) + 2
Else
StartOfWeek = D - WeekDay(D, FirstWeekday) + 1
End If
MsgBox "Первый день недели - " & StartOfWeek
End Function
--------------------------------------------------------------------------------
' Последний день недели
Function EndOfWeek(Optional D As Variant) As Variant '
Dim FirstWeekday As Integer
FirstWeekday = 2
If IsMissing(D) Then 'Последний день недели - воскресенье
D = Date
EndOfWeek = D - WeekDay(D) + 8
Else
EndOfWeek = D - WeekDay(D, FirstWeekday) + 7
End If
MsgBox "Последний день недели - " & EndOfWeek
End Function
--------------------------------------------------------------------------------
Function LeapYear(YYYY As Integer) As Integer
'Функция возвращает -1, если указанный входной параметр (год) является високосным
'Пример: MsgBox LeapYear(1996)
LeapYear = YYYY Mod 4 = 0 And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0)
If LeapYear = -1 Then
MsgBox "Високосный"
Else
MsgBox "Простой год"
End If
End Function
--------------------------------------------------------------------------------
Function LeapYear2(YYYY As Integer) As Integer
'Функция возвращает -1, если указанный входной параметр (год) является високосным
'Пример: MsgBox LeapYear(1996)
LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2
If LeapYear2 = -1 Then
MsgBox "Високосный"
Else
MsgBox "Простой год"
End If
End Function
--------------------------------------------------------------------------------
Function IsLeapYear(DateIn As Date) As Boolean
'Функция возвращает True, если год в указанной дате является високосным
'Проверка: MsgBox IsLeapYear("01/01/00")
If IsDate("29/02/" & Format(DateIn, "yyyy")) = True Then
IsLeapYear = True
MsgBox "Високосный"
Else
MsgBox "Простой год"
End If
End Function
--------------------------------------------------------------------------------
' Определение номера дня недели в году
Function DayOfYear(Optional dteDate As Date) As Long
If CLng(dteDate) = 0 Then
dteDate = Date
End If
DayOfYear = Abs(DateDiff("d", dteDate, DateSerial(Year(dteDate) - 1, 12, 31)))
MsgBox "День № " & DayOfYear & " в году"
End Function
--------------------------------------------------------------------------------
' Рабочий день или нет
Function IsWorkday(Optional dteDate As Date) As Boolean
If CLng(dteDate) = 0 Then
dteDate = Date
End If
Select Case WeekDay(dteDate)
Case vbMonday To vbFriday
IsWorkday = True
MsgBox "Рабочий день"
Case Else
IsWorkday = False
MsgBox "Выходной"
End Select
End Function
--------------------------------------------------------------------------------
'Функция определения полных лет со дня рождения
Function CalcAge(dteBirthdate As Date) As Long
'В качестве параметра dteBirthdate необходимо задать дату рождения
'Пример: MsgBox CalcAge("09/03/75")
Dim lngAge As Long
If Not IsDate(dteBirthdate) Then
dteBirthdate = Date
End If
'Проверить, чтобы в качестве входного параметра не была задана дата в будущем
If dteBirthdate > Date Then
dteBirthdate = Date
End If
'Подсчет разницы в годах между текущей датой и датой рождения
lngAge = DateDiff("yyyy", dteBirthdate, Date)
'Вычитается один год, если в этом году дня рождения еще не было
If DateSerial(Year(Date), Month(dteBirthdate), Day(dteBirthdate)) > Date Then
lngAge = lngAge - 1
End If
CalcAge = lngAge
MsgBox "Итого полных лет - " & CalcAge
End Function
--------------------------------------------------------------------------------
'Функция возвращает последний рабочий день в текущем месяце (Понедельник-Пятница)
Function LastBusDay(D As Variant) As Variant
'Пример: MsgBox LastBusDay(Date)
Dim D2 As Variant
If VarType(D) <> 7 Then
LastBusDay = Null
Else
D2 = DateSerial(Year(D), Month(D) + 1, 0)
Do While WeekDay(D2) = 1 Or WeekDay(D2) = 7
D2 = D2 - 1
Loop
LastBusDay = D2
End If
MsgBox "Последний рабочий день - " & LastBusDay
End Function
--------------------------------------------------------------------------------
Матющенко Георгий
|
| |
| |
| |
| |
|
|
| | А вот от Serge_Gavrilov
Вопрос: Проблемы с датами
Совет:
...а я пользую функцию типа to_lng и по-любому везде с датами все работает...
' "SELECT * FROM Rates WHERE to_lng(InputDate)=" & to_lng(Format(Now(),"dd.mm.yyyy"))
а собственно Date работает
попробуй с to_lng, указанным выше, а то с этими датами проблем не оберешься...
- неправильные национальные настройки
- прибабахи SQL по работе только с амрыканскими датами, да еще и ## решетки им дай
... уж и не вспомню, что еще, но меня эта лабуда достала еще в аксес2.0 и я пользую to_lng или to_dbl (если и время надо) а точнее вот такой маленький модуль... в неизменном виде с 1994 года...
Option Compare Database
Option Explicit
Public X, Y, Z
Function to_cur(Num) As Currency
On Error Resume Next
to_cur = CCur(Num)
If Err <> 0 Then to_cur = 0
If IsNull(Num) Then to_cur = 0
On Error GoTo 0
End Function
'==============
Function to_dbl(Num) As Double
On Error Resume Next
to_dbl = CDbl(Num)
If Err <> 0 Then to_dbl = 0
If IsNull(Num) Then to_dbl = 0
On Error GoTo 0
End Function
'==============
Function to_int(Num) As Integer
On Error Resume Next
to_int = CInt(Num)
If Err <> 0 Then to_int = 0
If IsNull(Num) Then to_int = 0
On Error GoTo 0
End Function
'==============
Function to_lng(Num) As Long
On Error Resume Next
to_lng = CLng(Num) 'ВНИМАНИЕ! См. замечание ниже
If Err <> 0 Then to_lng = 0
If IsNull(Num) Then to_lng = 0
On Error GoTo 0
End Function
'==============
Function to_sng(Num) As Single
On Error Resume Next
to_sng = CSng(Num)
If Err <> 0 Then to_sng = 0
If IsNull(Num) Then to_sng = 0
On Error GoTo 0
End Function
'==============
Function to_str(VarStr) As String
On Error Resume Next
to_str = CStr(VarStr)
If Err <> 0 Then to_str = ""
If IsNull(VarStr) Then to_str = ""
On Error GoTo 0
End Function
'==============
Function to_date(VarDate) As Date
On Error Resume Next
to_date = CDate(VarDate)
If Err <> 0 Then to_date = 0
If IsNull(VarDate) Then to_date = 0
On Error GoTo 0
End Function
'==============
AR
========
========
Некоторое замечание...
Если использовать CLng() для полной даты, то можете ошибиться.
Например сейчас Now дает
?now()
28.01.2003 13:03:14
В Double это:
?cdbl(cdate("28.01.2003 13:03:14"))
37649,543912037
CLng() даст 37650, т.е. другую дату:
?cdate(37650)
29.01.2003
Надо еще Int пользоваться
?сLng(Int(now()))
37649
Serge_Gavrilov
|
| |
| |
| |
| |
|
|
| | Может чё пригодиться и стоит добавить? | |
| |
| |
| |
|
|
| | А это вот коментировано не по нашему - я тут плохо понимаю, но функции хорошие - может пригодятся какие для класса
Вопрос: Работа с датами и временем
Совет:
Option Compare Database 'Use database order for string comparisons
Option Explicit
Const MB_ICONEXCLAMATION = 48
'************************************************************************
'* Function ConDateTime (anyDate As Variant, anyTime As Integer)
'* By John W.Locke JoLocke@AOL.com
'* 1/19/96
'*
'* Some applications, such as DBase, store date and time values in sep-
'* arate fields. This function will concatenate those into a single Date
'* and Time string that is usable by Access. The Date/Time value can
'* then be stored, or used in forms, queries or reports.
'*
'* This function requires the TimeValue function to convert time stored
'* as numeric data into an Access Time value.
'************************************************************************
Function ConDateTime (anydate As Variant, anytime As Integer)
On Error GoTo Err_ConDateTime
'/* A negative or Null value is unlikely, but we will trap for it anyway, */
'/* because it could cause an "Illegal Function" error */
If (IsNull(anytime) Or (anytime < 0) Or (anytime >= 1440)) Then
MsgBox "The value '" & anytime & "' is not a valid Time number.", MB_ICONEXCLAMATION, "ConDateTime Invalid Time"
GoTo Exit_ConDateTime
Else
End If
If IsDate(anydate) = False Then
MsgBox "The value '" & anydate & "' is not a valid Date.", MB_ICONEXCLAMATION, "ConDateTime Invalid Date"
GoTo Exit_ConDateTime
Else
End If
ConDateTime = DateValue(anydate) & " " & TimeValue(ConvTime(anytime))
Exit_ConDateTime:
Exit Function
Err_ConDateTime:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION, "ConDateTime Error Message"
Resume Exit_ConDateTime
End Function
'************************************************************************
'* Function ConvTime (anyNum)
'* By John W.Locke JoLocke@AOL.com
'* 1/19/96
'*
'* This funtion will convert numeric time values, such as those stored
'* by dBase, into an Access Time value. This can then be used by itself
'* or concatenated with a date value via the ConDateTime function.
'*
'* This function assumes the time value is being stored as an integer
'* between 0(12:00:00 am)and 1439(11:59:00 pm), where 1 = 1 minute.
'************************************************************************
Function ConvTime (anyNum)
On Error GoTo Err_ConvTime
anyNum = IIf(IsNull(anyNum), 0, anyNum)
'/* a negative value is unlikely, but we will trap for it anyway. */
If ((anyNum < 0) Or (anyNum >= 1440)) Then
MsgBox "The value '" & anyNum & "' is not a valid Time number.", MB_ICONEXCLAMATION, "ConvTime Invalid Time"
GoTo Exit_ConvTime
End If
ConvTime = TimeValue(Trim$((Int(anyNum / 60))) & ":" & IIf((((anyNum / 60) - Int(anyNum / 60)) * 60) >= 10, Trim$((((anyNum / 60) - Int(anyNum / 60)) * 60)), "0" & Trim$((((anyNum / 60) - Int(anyNum / 60)) * 60))))
Exit_ConvTime:
Exit Function
Err_ConvTime:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION, "ConvTime Error Message"
Resume Exit_ConvTime
End Function
'************************************************************************
'* Function TimeElapsed (Date1, Date2) As Variant
'* By John W.Locke JoLocke@AOL.com
'* 1/19/96
'*
'* This function computes the elapsed time between 2 dates, excluding
'* weekends. It accepts dates as Date/Time strings or Access Date/Time
'* values. It returns a Variant TimeValue that can be formatted in a
'* query, form or report.
'*
'************************************************************************
Function TimeElapsed (Date1, Date2) As Variant
On Error GoTo Err_TimeElapsed
Dim Time1, Time2, ElapsedTime, ElapsedDays, ElapsedPartialDay '/* Variants */
Dim vwknd As Integer
Time1 = CVDate(Date1)
Time2 = CVDate(Date2)
vwknd = DatePart("ww", Time2) - DatePart("ww", Time1)
If vwknd > 0 Then
vwknd = vwknd * 2
Else
vwknd = vwknd
End If
ElapsedTime = Abs(Time1 - Time2)
ElapsedDays = Int(ElapsedTime)
ElapsedPartialDay = (ElapsedTime - ElapsedDays)
TimeElapsed = ElapsedTime - vwknd
Exit_TimeElapsed:
Exit Function
Err_TimeElapsed:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION, "TimeElapsed Error Message"
Resume Exit_TimeElapsed
End Function
'************************************************************************
'* Function DateBeg (varDate, sPeriod As Integer)
'* By John W.Locke JoLocke@AOL.com
'* 2/1/96
'* Used to get Beginning Date from DateRanger Function. See comments in
'* DateRanger function.
'************************************************************************
Function DateBeg (varDate, sPeriod As Integer)
On Error GoTo Err_DateBeg
DateBeg = Left$(DateRanger(varDate, sPeriod), 8)
Exit_DateBeg:
Exit Function
Err_DateBeg:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION , "DateBeg Error Message"
Resume Exit_DateBeg
End Function
'************************************************************************
'* Function DateEnd (varDate, sPeriod As Integer)
'* By John W.Locke JoLocke@AOL.com
'* 2/1/96
'*
'* Used to get Ending Datefrom DateRanger Function. See comments in
'* DateRanger function.
'************************************************************************
Function DateEnd (varDate, sPeriod As Integer)
On Error GoTo Err_DateEnd
DateEnd = Right$(DateRanger(varDate, sPeriod), 8)
Exit_DateEnd:
Exit Function
Err_DateEnd:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION , "DateEnd Error Message"
Resume Exit_DateEnd
End Function
'************************************************************************
'* Function DateRanger (varDate As Variant, sPeriod As Integer)
'* By John W.Locke JoLocke@AOL.com
'* 2/1/96
'*
'* This function will return starting and ending dates for pre-defined
'* date ranges. For example, if varDate = 1/15/96 and sPeriod = 1,
'* DateRanger will return 12/1/95 as the starting date, and 12/31/95 as
'* the ending date.
'*
'* Date ranges currently supported are:
'* Last Month - sPeriod =1 Last Quarter - sPeriod = 3
'* Last Trimester - sPeriod = 4 Last SemiAnnual - sPeriod = 6
'* Last Week - sPeriod = 7 Last Year - sPeriod = 12
'*
'* DateRanger is called from it's 2 "front-end" functions, DateBeg and
'* DateEnd. Usage example:
'* DateBeg(#2/12/96#,3) = 11/01/95
'* DateEnd(#2/12/96#,3) = 01/31/96
'************************************************************************
Function DateRanger (varDate As Variant, sPeriod As Integer)
On Error GoTo Err_DateRanger
Dim BegDate, EndDate As Variant
Dim x, y, vDay As Integer
Select Case sPeriod
Case 1
y = 365.25 / 12 'Last Month(1 month)
Case 3
y = 365.25 / 4 'Last Quarter(3 months)
Case 4
y = 365.25 / 3 'Last Trimester(4 months)
Case 6
y = 365.25 / 2 'Last Semi-Annual(6 months)
Case 7
GoTo Weeks 'Last Week(1 week)
Case 12
y = 365.25 'Last Year(12 months)
Case Else
MsgBox "Wrong Value Entered."
Exit Function
End Select
BegDate = DateSerial(Year(varDate - y), Month(DateAdd("m", -sPeriod, varDate)), 1)
EndDate = DateAdd("m", sPeriod, (BegDate)) - 1
DateRanger = Format$(BegDate, "mm/dd/yy") & Format$(EndDate, "mm/dd/yy")
GoTo Exit_DateRanger
Weeks:
x = Weekday(varDate)
Select Case x
Case 1
vDay = -7
Case 2
vDay = -8
Case 3
vDay = -9
Case 4
vDay = -10
Case 5
vDay = -11
Case 6
vDay = -12
Case 7
vDay = -13
Case Else
GoTo Err_DateRanger
End Select
BegDate = DateAdd("d", vDay, varDate)
EndDate = DateAdd("d", vDay + 7, varDate)
DateRanger = Format$(BegDate, "mm/dd/yy") & Format$(EndDate, "mm/dd/yy")
GoTo Exit_DateRanger
Exit_DateRanger:
Exit Function
Err_DateRanger:
If IsNull(varDate) Then
MsgBox "This is a Null Date!"
Resume Next
ElseIf IsDate(varDate) = False Then
Resume Next
End If
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION , "DateRanger Error Message"
Resume Exit_DateRanger
End Function
'************************************************************************
'* Function EndOfMonth (vDate)
'* By John W.Locke JoLocke@AOL.com
'* 2/1/96
'*
'* This function accepts any valid date and returns the last day of the
'* month. Includes logic to compute "Leap Day".
'* For example:
'* EndOfMonth(#2/12/96#) = 29
'************************************************************************
Function EndOfMonth (vDate)
On Error GoTo Err_EndOfMonth
Dim x, EOM As Integer
Select Case Month(vDate)
Case 1, 3, 5, 7, 10, 12
x = 31
Case 4, 6, 8, 9, 11
x = 30
Case 2
If Year(vDate) Mod 4 = 0 Then
x = 29
Else
x = 28
End If
Case Else
MsgBox "Invalid Month in Date"
End Select
EOM = x
EndOfMonth = EOM
Exit_EndOfMonth:
Exit Function
Err_EndOfMonth:
MsgBox Err & " " & Error$, MB_ICONEXCLAMATION , "EndOfMonth Error Message"
Resume Exit_EndOfMonth
End Function
|
| |
| |
| |
| |
|
|
| | или вот махонький совет:
С датами в Access работают как с целыми числами. Например, если Вам надо определить последнее число месяца делается это так.
d = Date 'Текущая дата
m = Month(d) 'Определяем месяц
y = Year(d) 'Определяем год
DLast = DateSerial(y, m + 1, 1) - 1 'Последний день месяца | |
| |
| |
| |
|
|
| | Возможно и такие вот функции можно применить в этом классе тасазать до кучи.
Вопрос: Сколько выходных между двумя датами
Совет:
Date/Time: How many Sundays between two dates
--------------------------------------------------------------------------------
From an initial observation made by Lyle Fairfield, here a solution to getthe number of, let say, Wednesday, between two dates:
'************* Code Start *************
Public Function HowManyWD(FromDate As Date, _
ToDate As Date, _
WD As Long)
' No error handling actually supplied
HowManyWD = DateDiff("ww", FromDate, ToDate, WD) _
- Int(WD = WeekDay(FromDate))
End Function
'************* Code End *************
In the same way, someone can easily get the number of weekdays (excluding weekends) by subtracting number of Sundays and Saturdays:
'************* Code Start *************
Public Function HowManyWeekDay(FromDate As Date, _
ToDate As Date, _
Optional ToDateIsIncluded As Boolean = True)
HowManyWeekDay = DateDiff("d", FromDate, ToDate) - _
ToDateIsIncluded - _
HowManyWD(FromDate, ToDate, vbSunday) - _
HowManyWD(FromDate, ToDate, vbSaturday)
End Function
'************* Code End *************
код не мой автора не знаю, но возможно Евгений Серебряков
|
| |
| |
| |
| |
|
|
| | Интересные наброски попались
Функция вычисления разницы между двумя датами
Function FormatInterval(ByVal Interval As Variant, Fmt As String)
'
' Formats the difference between 2 dates or sum of 2 times
' to show day as well as hours, minutes, and seconds.
'
' Supports the following formats:
' D H 5 Days 5 Hours
' D H:MM 5 Days 5:15
' D HH:MM 5 Days 05:15
' D H:MM:SS 5 Days 5:15:45
' D HH:MM:SS 5 Days 05:15:45
' H M 125 Hours 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Seconds
'
Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
'
' Check for Date or Double
'
If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function
'
' Parse Days
'
Days = Int(Interval)
Interval = Interval - Days
If Interval > #11:59:59 PM# Then
Days = Days + 1
Interval = 0#
End If
'
' Parse Hours
'
Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours
If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If
'
' Parse Minutes
'
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes
If Interval > 59# / 60# Then
Minutes = Minutes + 1
Interval = 0#
End If
'
' Parse Seconds
'
Seconds = Int(Interval * 60 + 0.5)
'
' Normalize
'
If Seconds = 60 Then
Minutes = Minutes + 1
Seconds = 0
End If
If Minutes > 59 Then
Hours = Hours + 1
Minutes = Minutes - 60
End If
If Hours > 23 Then
Days = Days + 1
Hours = Hours - 24
End If
'
' Create format
'
Select Case Fmt
Case "D H"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours &
IIf(Hours <> 1, " Hours", " Hour")
Case "D H:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours &
":" & Format(Minutes, "00")
Case "D HH:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") &
Format(Hours, "00") & ":" & Format(Minutes, "00")
Case "D H:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "D HH:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "H M"
Hours = Hours + Days * 24
FormatInterval = Hours & IIf(Hours <> 1, " Hours ", " Hour ") & Minutes & IIf(Minutes <> 1, " Minutes", " Minute")
Case "H:MM"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00")
Case "H:MM:SS"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "M S"
Minutes = Minutes + (Hours + Days * 24) * 60
FormatInterval = Minutes & IIf(Minutes <> 1, " Minutes ", " Minute ") & Seconds & IIf(Seconds <> 1, " Seconds", " Second")
Case Else
FormatInterval = Null
End Select
End Function
|
| |
| |
| |
| |
|
|
| | Такое ощущение, что час в модуль класса не заглядывал.
Там 90% этого уже есть. | |
| |
| |
| |
|
|
| | заглядывал, извините, просто может чё интересное в этом коде попадётся....
Я не нарочно.... я просто выложил, для обозрения - прости если чё не так
А не вырезал, что ба не ошибиться. | |
| |
| |
| |
|
|
| | Да я без обид. Просто слишком много.  | |
| |
| |
| |
|
|
| | Уважаемый Lukas ? а вы описалово дополните........??? | |
| |
| |
| |
|
|
| | Я думаю, нам пора на ты, уже не одну выпили вместе.
Описание clsDate попробую наваять. | |
| |
| |
| |
|
|
| | Извините - этикет блюдю.
Чё тока не прочитаешь про эти даты
универсальный формат даты
Универсальный формат даты имеет вид #yyyy-mm-dd hh:mm:ss#. Однако оба компонента, даты (#yyyy-mm-dd#) и времени (#hh:mm:ss#), допускают независимое представление.
|
почему-то год вообще впереди..... | |
| |
| |
| |
|
|
| | Ничего удивительного.
Такой формат удобен для сортировки дат, когда даты представлены в формате строки | |
| |
| |
| |
|
|
| | Ясненько - удобнее стало быть.... | |
| |
| |
| |
2 Кб. |
|
| | Описание класса clsDate.
Описал как умел. | |
| |
| | |
|
| |
|
|
| | А проясните пожалуйста ситуацию.
Про модули класса.
У меня вощем-то ужеимеются модули (не класса), которые кочуют из базы в базу
это такие модули, как : Модуль таблиц, модуль дат, модуль ссылок и т.д.
И я значит ипользую функции. расположеные в этих модулях.
А чем модуль класса лучше?
Обращение так же идёт к опред. функц. находящейся в этом классе, но ещё надо создавать экземпляр класса.
Я чёта никак свого счастья не пойму???  | |
| |
| |
| |
|
|
| | Сенькс за функции.
Со временем можно и дополнить класс. Но до ноября не будет времени.
А по поводу того, нужен ли класс, если есть модули с функциями, то в аксе это не принципиально. Удобство заключается в том, что нет необходимости запоминать название всех ф-ций. Класс сам подсказывает название функций.
Не знаю поддерживает, ли VBA наследование и полиморфизм, но VB.Net это поддерживается, поэтому создание классов там имеет смысл. Собственно, именно в VB.Net я и пришел к удобству создания классов. В аксе я их не использовал. | |
| |
| |
| |
|
|
| | Будем ждать Вашего возвращения в наши ряды.....  ...
Удачи на трудном задании.......  | |
| |
| |
| |
|
|
| | Спасибо понятно -
подсказки - лучше, чем надежда на то, что все названия запомнишь. | |
| |
| |
| |
28 Кб. |
|
| | Вариант №3 класса дат.
Добавил функции даты (первого и последнего дня) предыдущего и следующего (квартала, месяца, недели).
Подправил функции дат начала и конца недели.(У меня был сдвиг на 1 день) | |
| |
| | |
|
| |
|
|
| | Огромные черные дыры в познаниях не дают возможности ответить на этот вопрос.
Но, думаю в данном случае, это не принципиально. Можно переписать и через функции. | |
| |
| |
| |
|
|
| | Думается, что где есть Public Property Get, там может быть и Public Property Let (Set). Т.е. в отличие от Public Function, може получаем свойство объекта Read/Write. | |
| |
| |
HiProg.com - Технологии программирования
|
