Ответить на сообщение
Вернуться к теме
Вы отвечаете на сообщение:
ник: час А это вот коментировано не по нашему - я тут плохо понимаю, но функции хорошие - может пригодятся какие для класса
Вопрос: Работа с датами и временем Совет: 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
Ваше имя:
Пароль:
Сообщение:
Прикрепить:
Для вставки смайлов в текст щелкните по значку.