| Вопрос: Кол-во дней в месяце текущей даты | Добавлено: 27.09.05 07:59 |
Автор вопроса:  Alik
|
|
Как можно получить кол-во дней в месяце текущей даты.
Например, сегодня 27 сентября, определить что сентябрь и получить число - 30 дней |
| Ответы | Всего ответов: 3 |
|
Номер ответа: 1 Автор ответа: el-paso Вопросов: 3 Ответов: 164 |
Профиль | | #1 | Добавлено: 27.09.05 09:16 |
|
Первое, что пришло в голову:
Function CurrentMonthLength(DateValue As Date) As Integer
' Dim d& ' d = Day(DateAdd("d", 31 - Day(DateValue), DateValue)) CurrentMonthLength = Choose(d + 1, 31, 30, 29, 28) ' End Function |
||
|
Номер ответа: 2 Автор ответа:  GSerg Вопросов: 0 Ответов: 1876 
|
Профиль | | #2 | Добавлено: 27.09.05 22:18 |
|
function cml(byval d as date) as long
cml=day(dateserial(year(d), month(d)+1,1)-1) end function |
||
|
Номер ответа: 3 Автор ответа: the Pagan ICQ: нет Вопросов: 19 Ответов: 27 |
Web-сайт: Профиль | | #3 | Добавлено: 01.10.05 12:29 |
|
Примеры работы с датами
Небольшое примечание: если в качестве входного параметра указано (Optional dteDate As Date), то вызов функции можно осуществлять как НазваниеФункции() - то есть можно оставлять пустые скобки. Например MsgBox FirstOfQuarter() Список функций Определение первого/последнего дня текущего квартала Определение первого/последнего дня месяца Определение первого/последнего дня следующего месяца Определение первого/последнего дня предыдущего месяца Определение первого/последнего дня текущей недели Опредение номера дня в году (2 января = 2, 3 февраля = 34) Данная функция определяет рабочий день или нет Возвращение последнего рабочего дня в текущем месяце Функция определения полных лет со дня рождения Вычисление разницы в годах между двумя датами Определение високосности года Определение первого дня текущего квартала 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) End Function Определение последнего дня текущего квартала Function LastOfQuarter(Optional dteDate As Date) As Date If CLng(dteDate) = 0 Then dteDate = Date End If LastOfQuarter = DateSerial(Year(Date), Int((Month(Date) - 1) / 3) * 3 + 4, 0) End Function Определение первого дня месяца 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) 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 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) 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) 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) 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) End Function Определение первого дня текущей недели Function StartOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant ' 'Пример: MsgBox StartOfWeek(Date) If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week. StartOfWeek = D - Weekday(D) + 1 Else StartOfWeek = D - Weekday(D, FirstWeekday) + 1 End If End Function Определение последнего дня текущей недели Function EndOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant 'Пример: MsgBox EndOfWeek(Date) If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week. EndOfWeek = D - Weekday(D) + 7 Else EndOfWeek = D - Weekday(D, FirstWeekday) + 7 End If End Function Опредение номера дня в году (2 января = 2, 3 февраля = 34) 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))) 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 Case Else IsWorkday = False End Select 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 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 End Function Вычисление разницы в годах между двумя датами Естественно, что значение Bdate должно быть меньше параметра DateToday Function Age(Bdate, DateToday) As Integer 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 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) End Function Function LeapYear2(YYYY As Integer) As Integer 'Функция возвращает -1, если указанный входной параметр (год) является високосным 'Пример: MsgBox LeapYear(1996) LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2 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 End If End Function |
||
Страница: 1 |