Public Sub FillMonthLabels(frm As Access.Form, theYear As Integer)
Dim ctl As Access.Label
Dim I As Integer
Dim amonths() As Variant
Dim theMonth As Variant
Dim FirstDayOfMonth As Date 'First of month
Dim DaysInMonth As Integer 'Days in month
Dim intOffSet As Integer 'Offset to first label for month.
Dim intDay As Integer 'Day under consideration.
Dim monthCounter As Integer
Const ctlBackColor = -2147483616 'Used for Holiday shading/Unshading
amonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
For monthCounter = 1 To 12
FirstDayOfMonth = getFirstOfMonth(theYear, monthCounter)
DaysInMonth = getDaysInMonth(FirstDayOfMonth) 'Days in month.
intOffSet = getOffset(theYear, monthCounter, vbSaturday) 'Offset to first label for month.
For I = 1 To 37
Set ctl = frm.Controls("lbl" & amonths(monthCounter - 1) & I)
ctl.Caption = ""
ctl.BackColor = ctlBackColor 'reset the backcolor
intDay = I - intOffSet 'Transforms label number to day in month
If intDay > 0 And intDay <= DaysInMonth Then
ctl.Caption = intDay
If isHoliday(FirstDayOfMonth + (intDay - 1)) Then ctl.BackColor = vbGreen
End If
Next I
Next monthCounter
End Sub
Public Sub FillTextBoxes(frm As Access.Form, shipName As String, theYear As Integer)
Dim ctl As Access.TextBox
Dim rs As DAO.Recordset
Dim strSql As String
Dim strMonth As String
Dim intMonth As Integer
Dim intDay As Integer
Dim orderdate As Date
Dim FirstDayOfMonth As Date
Dim intOffSet As Integer
shipName = Replace(shipName, "'", "''")
strSql = "Select * from qryOrders where ShipName = '" & shipName & "' "
strSql = strSql & "AND year(orderDate) = " & theYear
Set rs = CurrentDb.OpenRecordset(strSql)
clearTextBoxes frm
Do While Not rs.EOF
orderdate = rs!orderdate
strMonth = Format(orderdate, "mmm")
intDay = Day(orderdate)
intMonth = Month(orderdate)
FirstDayOfMonth = getFirstOfMonth(theYear, intMonth) 'First of month
intOffSet = getOffset(theYear, intMonth, vbSaturday) 'Offset to first label for month.
Set ctl = frm.Controls("txt" & strMonth & intDay + intOffSet)
ctl.Value = "Ord"
rs.MoveNext
Loop
End Sub
Public Sub clearTextBoxes(frm As Access.Form)
Dim ctl As Access.TextBox
Dim I As Integer
Dim amonths() As Variant
Dim theMonth As Variant
Dim monthCounter As Integer
amonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
For monthCounter = 1 To 12
For I = 1 To 37
Set ctl = frm.Controls("txt" & amonths(monthCounter - 1) & I)
ctl.Value = ""
Next I
Next monthCounter
End Sub
Public Function gridClick()
'This just demoes a single function that fires when any of the grid text boxes are clicked
Dim ctl As Access.Control
Dim strMonth As String
Dim intCol As String
Dim intMonth As Integer
Dim intDay As Integer
Dim frm As Access.Form
Dim intYear As Integer
Dim selectedDate As Date
Set ctl = Screen.ActiveControl
Set frm = ctl.Parent
strMonth = Replace(Split(ctl.Tag, ";")(0), "txt", "")
intCol = CInt(Split(ctl.Tag, ";")(1))
intYear = Year(frm.dtpYear.Value)
intMonth = getIntMonthFromString(strMonth)
intDay = intCol - getOffset(intYear, intMonth, vbSaturday)
selectedDate = DateSerial(intYear, intMonth, intDay)
'Since you know the date you could now open a form to
'add, edit, or delete a value for that date and that shipper
MsgBox selectedDate
End Function
Public Function getOffset(intYear As Integer, intMonth As Integer, Optional DayOfWeekStartDate As Long = vbSunday) As Integer
'If your calendar starts on Sunday and the first day of the month is on a Monday
'Then everything is shifted one day so label 2 is day one
'If the first day was Saturday then everything shifts 6 days. So label seven shows 1
Dim FirstOfMonth As Date
FirstOfMonth = getFirstOfMonth(intYear, intMonth)
getOffset = Weekday(FirstOfMonth, DayOfWeekStartDate) - 1
End Function
Public Function getFirstOfMonth(intYear As Integer, intMonth As Integer) As Date
getFirstOfMonth = DateSerial(intYear, intMonth, 1)
End Function
Public Function getDaysInMonth(FirstDayOfMonth As Date) As Integer
getDaysInMonth = Day(DateAdd("m", 1, FirstDayOfMonth) - 1) 'Days in month.
End Function
Public Function getIntMonthFromString(strMonth As String) As Integer
'Assume Jan, Feb..Dec
getIntMonthFromString = Month("1/" & strMonth & "/2013")
End Function
