Option Explicit
Option Compare Database

Const constShaded = 12632256         ' Shaded text box
Const constUnshaded = 16777215       ' Unshaded text box
Const constBackground = -2147483633  ' Background color for form (for unused textboxes)

Private Sub btnNextMonth_Click()
    Dim ReferenceDate As Date
    Dim NewDate As Date

    ' Load the current date from the form
    ReferenceDate = Me.txtCalendarHeading

    ' Add 1 month to the date
    NewDate = DateAdd("m", 1, ReferenceDate)

    RefreshCalendar DatePart("m", NewDate), DatePart("yyyy", NewDate)

End Sub

Private Sub btnPrevMonth_Click()
    Dim ReferenceDate As Date
    Dim NewDate As Date

    ' Load the current date from the form
    ReferenceDate = Me.txtCalendarHeading

    ' Subtract 1 month from the date
    NewDate = DateAdd("m", -1, ReferenceDate)

    RefreshCalendar DatePart("m", NewDate), DatePart("yyyy", NewDate)

End Sub

Private Sub CalendarOverlay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Row As Integer
    Dim Col As Integer
    Dim TextBoxIndex As Integer
    Dim DayIndex As Integer
    Dim strNum As String
    Dim ctl As Control
    Dim intYear As Integer
    Dim intMonth As Integer
    Dim intMaxDays As Integer

    ' MsgBox "Button Mouse Down - X: " & X & " Y: " & Y    '  <== Use this to figure out dimensions
    Const ButtonWidth = 3045 ' Maximum X value (found by experimenting with MsgBox enabled)
    Const ButtonHeight = 2025  ' Maximum Y value (found by experimenting with MsgBox enabled)

    ' Convert X and Y to Row, Col equivalents on the table
    Col = Int(X / (ButtonWidth / 7)) + 1  ' Divide width across 7 days
    Row = Int(Y / (ButtonHeight / 6)) + 0  ' Divide height across 6 rows (for the calendar)
    ' MsgBox "Button Mouse Down - Col: " & Col & " Row: " & Row   ' Debugging statement

    ' Calculate the index and figure out which text box
    TextBoxIndex = Row * 7 + Col

    ' Test to see if it is a day in the month
    DayIndex = TextBoxIndex - Weekday(Me.txtCalendarHeading) + 1

    intMaxDays = Day(DateAdd("d", -1, DateAdd("m", 1, Me.txtCalendarHeading)))

    If (DayIndex >= 1) And (DayIndex <= intMaxDays) Then

        ' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
        strNum = Right("00" & TextBoxIndex, 2)
        Set ctl = Me("CalDay" & strNum)     ' Note: similar to Me.Caldayxx, but allows a string

        ' Toggle shading -- Just for demonstration
        If ctl.BackColor = constUnshaded Then
            ctl.BackColor = constShaded
        Else
            ctl.BackColor = constUnshaded
        End If

        ' MsgBox the click -- Just for demonstration
        intYear = Year(Me.txtCalendarHeading)
        intMonth = Month(Me.txtCalendarHeading)
        MsgBox "Clicked on " & DateSerial(intYear, intMonth, DayIndex)

    End If

End Sub

Private Sub Form_Load()

    ' Call the refresh procedure
    ' Use the current date to start
    RefreshCalendar DatePart("m", Date), DatePart("yyyy", Date)

End Sub

Public Function RefreshCalendar(intMonth As Integer, intYear As Integer)

    ' Initialize the calendar grid
    ClearCalendar

    ' Set the date into the Calendar Heading
    ' Note this date is always the first of the displayed month (but field only shows month/year)
    Me.txtCalendarHeading = DateSerial(intYear, intMonth, 1)

    ' Add numbers to the calendar
    NumberCalendar

End Function

Private Sub ClearCalendar()
    Dim TextBoxIndex As Integer
    Dim strNum As String
    Dim ctlCalendar As Control
    Dim ctlInitial As Control

    ' Initialize the calendar grid to blanks
    For TextBoxIndex = 1 To 42

        ' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
        strNum = Right("00" & TextBoxIndex, 2)

        Set ctlCalendar = Me("CalDay" & strNum)  ' Note: similar to Me.Caldayxx, but allows a string
        ctlCalendar.Value = ""
        ctlCalendar.BackColor = constBackground
    Next

    Set ctlCalendar = Nothing

End Sub

Private Sub NumberCalendar()
    Dim FirstDay As Integer
    Dim DayIndex As Integer
    Dim TextBoxIndex As Integer
    Dim Done As Boolean

    Dim ctlCalendar As Control
    Dim strNum As String

    FirstDay = Weekday(Me.txtCalendarHeading)  ' Figure out the first day of the week
    DayIndex = 1   ' Start counting days at 1
    TextBoxIndex = FirstDay   ' Start indexing text boxes at first day in month
    Done = False

    While Not (Done)
        ' Set the value of the correct CalDayxx text box

        ' Make a 2-digit string with the number, e.g. "01" or "08" or "12" etc.
        strNum = Right("00" & TextBoxIndex, 2)

        Set ctlCalendar = Me("CalDay" & strNum) ' Note: similar to Me.Caldayxx, but allows a string
        ctlCalendar.Value = DayIndex
        ctlCalendar.BackColor = constUnshaded

        DayIndex = DayIndex + 1
        TextBoxIndex = TextBoxIndex + 1

        ' Are we done?  Check to see if we have indexed into next month
        If (Month(Me.txtCalendarHeading + (DayIndex - 1)) <> Month(Me.txtCalendarHeading)) Then
           Done = True
        End If

    Wend

    Set ctlCalendar = Nothing
End Sub