Option Explicit
Private Sub Form_Load()
Debug.Print MonthDays(2000, 2)
End Sub
Public Function MonthDays(Year As Long, Month As Long)
MonthDays = CGreg2Jul(Year, Month + 1, 1) - CGreg2Jul(Year, Month, 1)
End Function
'*****************************************************************************************
'* Name: CGreg2Jul
'* Author: YrWyddfa
'* Date: 20th May 2004
'*
'* Parameters: y,m,d LONG Gregorian date
'*
'* LONG Julian Date
'*
'* Notes: This function converts from a standard Gregorian date to the
'* astronomical Julian Day Number (not Julian Date - which starts again
'* at the beginning of each year at 1 fom Jan 1st)
'*
'* This function can handle dates from 1582 AD. This should be
'* enough scope for most uses.
'*
'* To convert to astronomical julian day number subtract 0.5
'*
'* Version: 20/05/2004 Created Yr
'*****************************************************************************************
Public Function CGreg2Jul(y As Long, m As Long, d As Long) As Long
Dim jy As Long
Dim ja As Long
Dim jm As Long
Dim intgr As Long
If (m > 2) Then
jy = y
jm = m + 1
Else
jy = y - 1
jm = m + 13
End If
intgr = Fix(Fix(365.25 * jy) + Fix(30.6001 * jm) + d + 1720995)
ja = Fix(0.01 * jy)
intgr = intgr + 2 - ja + Fix(0.25 * ja)
CGreg2Jul = intgr
End Function