Aucune

' Taken from Microsoft Knowledgebase Article ID: Q185480 'Age Age in years. 'DaysInMonth The number of days in the current month. 'DaysInMonth2 Alternate method. 'EndOfMonth Returns the date for the last day of the current month. 'EndOfWeek Returns the date for the last day in the current week. 'LastBusDay Returns the date for the last business day (Mon-Fri) ' in the current month. 'LeapYear Returns True or False if the year is a leap year. 'LeapYear2 Alternate method. 'NextDay Returns the date for the next day (Sun...Sat) after the ' current date. 'NextDay1 Returns the date for the next day (Sun...Sat) on or ' after the current date. 'PriorDay Returns the date for the last day (Sun...Sat) before ' the current date. 'PriorDay1 Returns the date for the last day (Sun...Sat) on or ' before the current date. 'StartOfMonth Returns the date for the first day of the current ' month. 'StartOfWeek Returns the date for the first day of the current week. Function Age(ByVal Bdate As Date, ByVal DateToday As Date) As Long ' Doesn't handle negative date ranges i.e. Bdate > DateToday. If Month(DateToday) < Month(Bdate) _ Or (Month(DateToday) = Month(Bdate) _ And Day(DateToday) < Day(Bdate)) Then Age = Year(DateToday) - Year(Bdate) - 1 Else Age = Year(DateToday) - Year(Bdate) End If End Function Function DaysInMonth(ByVal D As Date) As Long ' Requires a date argument because February can change ' if it's a leap year. Select Case Month(D) Case 2 If LeapYear(Year(D)) Then DaysInMonth = 29 Else DaysInMonth = 28 End If Case 4, 6, 9, 11 DaysInMonth = 30 Case 1, 3, 5, 7, 8, 10, 12 DaysInMonth = 31 End Select End Function Function DaysInMonth2(ByVal D As Date) As Long ' Requires a date argument because February can change ' if it's a leap year. DaysInMonth2 = Day(DateSerial(Year(D), Month(D) + 1, 0)) End Function Function EndOfMonth(ByVal D As Date) As Date EndOfMonth = DateSerial(Year(D), Month(D) + 1, 0) End Function Function EndOfWeek(ByVal D As Date) As Date EndOfWeek = D - Weekday(D) + 7 End Function Function LastBusDay(ByVal D As Date) As Date Dim D2 As Variant D2 = DateSerial(Year(D), Month(D) + 1, 0) Do While Weekday(D2) = 1 Or Weekday(D2) = 7 D2 = D2 - 1 Loop LastBusDay = D2 End Function Function LeapYear(ByVal YYYY As Long) As Boolean LeapYear = YYYY Mod 4 = 0 _ And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0) End Function Function LeapYear2(ByVal YYYY As Long) As Boolean LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2 End Function Function NextDay(ByVal D As Date, ByVal DayCode As Long) As Date ' DayCode (1=Sun ... 7=Sat) or use vbSunday...vbSaturday. NextDay = D - Weekday(D) + DayCode + _ IIf(Weekday(D) < DayCode, 0, 7) End Function Function NextDay1(ByVal D As Date, ByVal DayCode As Long) As Date NextDay1 = D - Weekday(D) + DayCode + _ IIf(Weekday(D) <= DayCode, 0, 7) End Function Function PriorDay(ByVal D As Date, ByVal DayCode As Long) As Date PriorDay = D - Weekday(D) + DayCode - _ IIf(Weekday(D) > DayCode, 0, 7) End Function Function PriorDay1(ByVal D As Date, ByVal DayCode As Long) As Date PriorDay1 = D - Weekday(D) + DayCode - _ IIf(Weekday(D) >= DayCode, 0, 7) End Function Function StartOfMonth(ByVal D As Date) As Date StartOfMonth = DateSerial(Year(D), Month(D), 1) End Function Function StartOfWeek(ByVal D As Date) As Date StartOfWeek = D - Weekday(D) + 1 End Function