vba datepart

Ответ от Михаил Шишканов[гуру]
Sub MacrosBirthDay()
'Рассчитать, в какой день недели вы родились
Dim BirthDay, BirthMonth, BirthYear
Dim JD, R
metka:
ans = InputBox("Введите день вашего рождения по образцу - dd. mm. yyyy :")
If Len(ans) = 0 Then GoTo metka
BirthDay = Val(Left(ans, 2))
BirthMonth = Val(Mid(ans, 4, 2))
BirthYear = Val(Right(ans, 4))
JD = JulianDay(BirthDay, BirthMonth, BirthYear)
R = (JD + 1.5) Mod 7
Select Case R
Case 0
R = "о воскресенье"
Case 1
R = " понедельник"
Case 2
R = " вторник"
Case 3
R = "а среда"
Case 4
R = " четверг"
Case 5
R = "а пятница"
Case 6
R = "а суббота"
End Select
MsgBox "Вы родились " + ans + " это был" + R
End Sub
Sub MacrosVremyaPostupleniya()
'Расчитать сколько времени прошло с момента вашего поступления в академию
Dim PostDay, PostMonth, PostYear
Dim JD, JD2, CurDate, R
metka:
ans = InputBox("Введите день вашего поступления в академию по образцу - dd. mm. yyyy :")
If Len(ans) = 0 Then GoTo metka
PostDay = Val(Left(ans, 2))
PostMonth = Val(Mid(ans, 4, 2))
PostYear = Val(Right(ans, 4))
JD = JulianDay(PostDay, PostMonth, PostYear)
CurDate = CStr(Date)
D = Val(Left(CurDate, 2))
M = Val(Mid(CurDate, 4, 2))
Y = Val(Right(CurDate, 4))
JD2 = JulianDay(D, M, Y)
R = JD2 - JD
MsgBox "Со времени вашего поступления в академию (" + ans + ") по сегодняшнюю дату (" + CurDate + ") прошло " + CStr(R) + " дней. "
End Sub
Function JulianDay(D, M, Y)
If M = 1 Or M = 2 Then
Y = Y - 1
M = M + 12
End If
A = Int(Y / 100)
B = 2 - A + Int(A / 4)
JulianDay = Int(365.25 * (Y + 4716)) + Int(30.6001 * (M + 1)) + D + B - 1524.5
End Function
Источник: Правильный алгоритм решения