Recurring Data and Yearly Calender Summary 1

[spartansFC]

Hi

I've used Duane Hookems recurring database example and created a form that populates booking information for a child's attendance from April 14 2013 to March 31 2014, the fields are:

dteSessionDates
ysnCurrentSession
lngChildID
lngClubID
lngPickedupFrom
lngSessionType
curSessionCost

and the data looks like

14/04/2013 True 100 100 100 1 10.00
15/04/2013 False 100 100 100 1 10.00
16/04/2013 False 100 100 100 1 10.00

so i can do the above, i've seen a great example of a yearly calender which i've attached where you can see which sessions the child is booked into. I know how to do crosstab queries but i'm not sure how to:

A: get the form to show all dates as days (Su, Mo, Tu, We... etc) along the top even when the child hasn't booked in for that day

I thought i might need a seperate table and connect it via dteSessionDates but that doesn't seem to work, it only shows the sessions the child is booked in for.

Has anyone ever tried to do a summary form like the one attached?

Any ideas

thanks

Mikie

 

[MajP]

Here is what the cleaned up version then looks like.

The actual database is located

http://www.4shared.com/file/2RtTtLjH/MajPYearCalendar_Ver1.html

Here is the cleaned up code to control the form.

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

here is the code in the form

Private Sub cmboShipTo_AfterUpdate()
 FillTextBoxes Me, Me.cmboShipTo, Year(dtpYear.Value)
End Sub

Private Sub dtpYear_Change()
 FillMonthLabels Me, Year(dtpYear.Value)
 If Not IsNull(Me.cmboShipTo) Then
   FillTextBoxes Me, Me.cmboShipTo, Year(dtpYear.Value)
 End If
End Sub

Private Sub Form_Load()
 FillMonthLabels Me, Year(dtpYear.Value)
 DoCmd.Maximize
End Sub

and here is the code to make the form. This makes and formats the grid. The user has to add the month labels, the day of the week names row, and some control to pick a year to display, and other controls like.
The only real change here is that you need 37 columns not 36.

Public Sub Main()
  'Need to run this code to create a form and then the controls
  CreateForm
  DoCmd.OpenForm "frmYearCalendar", acDesign
  formatGrid Forms("frmYearCalendar")
End Sub
Public Sub CreateForm()
  'This only creates and names the form
  Dim frm As Access.Form
  Dim strName As String
  Dim frmExists As AccessObject
  Set frm = Application.CreateForm
  frm.Visible = True
  strName = frm.Name
  DoCmd.Close acForm, frm.Name, acSaveYes
  For Each frmExists In CurrentProject.AllForms
    If frmExists.Name = "frmYearCalendar" Then
      DoCmd.Close acForm, "frmYearCalendar"
      DoCmd.DeleteObject acForm, "frmYearCalendar"
    End If
  Next frmExists
  DoCmd.Rename "frmYearCalendar", acForm, strName
End Sub

Public Sub formatGrid(frm As Access.Form)
  Const ctlWidth = (0.25 * 1440)
  Const ctlHeight = (0.25 * 1440)
  Const conStartLeft = (0.5 * 1440)
  Const conStartTop = (1 * 1440)
  
  Dim startLeft As Long
  Dim startTop As Long
  Dim lngRow As Long
  Dim lngCol As Long
  Dim intCounter As Long
  Dim ctl As Access.Control
  Dim amonths() As Variant
  
  amonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
  startLeft = conStartLeft
  startTop = conStartTop
  '12 Textbox rows, 12 label rows
  For lngRow = 1 To 24
     For lngCol = 1 To 37
    ' Debug.Print lngRow & " mod" & lngRow Mod 2
     If lngRow Mod 2 = 0 Then
       'text box row event row
        Set ctl = Application.CreateControl(frm.Name, acTextBox, acDetail)
        With ctl
         .Height = ctlHeight
         .Width = ctlWidth
         .Left = startLeft
         .Top = startTop
         .FontSize = 8
         .Visible = True
         .Tag = amonths(lngRow / 2 - 1) & ";" & lngCol
         .Name = "txt" & amonths(lngRow / 2 - 1) & lngCol
         'Add other formatting as necessary
         'Define the function here that they do when clicked.
         .OnClick = "=gridClick()"
       End With
     Else
       'label row
       Set ctl = Application.CreateControl(frm.Name, acLabel, acDetail)
       With ctl
         .Height = ctlHeight
         .Width = ctlWidth
         .Left = startLeft
         .Top = startTop
         .FontSize = 8
         .Visible = True
         .Tag = amonths((lngRow + 1) / 2 - 1) & ";" & lngCol
         'Debug.Print "lbl" & aMonths((lngRow + 1) / 2 - 1) & lngCol
         .BackStyle = 1
         .BackColor = -2147483616
         .BorderStyle = 1
         .Name = "lbl" & amonths((lngRow + 1) / 2 - 1) & lngCol
         'Add other formatting as necessary
       End With
     End If
     startLeft = startLeft + ctlWidth
     Next lngCol
     startLeft = conStartLeft
     startTop = startTop + ctl.Height
  Next lngRow
End Sub

Also you can click on any textbox and it will determine the date, and you should be able to pop up a form to add, edit, and delete information for that date.

 

[dhookom]

Nice code from MajP. I typically prefer to use queries and native form functionality.

For instance, taking the Northwind (older copy) with a table of all dates [tblDates] and field [TheDate] added.
First create a cartesian query to get every combination of ShipName and date:

SELECT tblDates.TheDate, Orders.ShipName
FROM tblDates, Orders
WHERE (((tblDates.TheDate) Between #1/1/1997# And #12/31/1997#))
GROUP BY tblDates.TheDate, Orders.ShipName;

Then create a crosstab to get 37 columns with all dates in the proper columns and the shipper in cells where there is an order:

TRANSFORM Max(Day([TheDate])) & Chr(13) & Chr(10) & Max([CustomerID]) AS Val
SELECT qcarDateShipTo.ShipName, Year([TheDate]) AS YR, Month([TheDate]) AS MTH
FROM qcarDateShipTo LEFT JOIN Orders ON (qcarDateShipTo.ShipName = Orders.ShipName) AND (qcarDateShipTo.TheDate = Orders.OrderDate)
GROUP BY qcarDateShipTo.ShipName, Year([TheDate]), Month([TheDate])
PIVOT [TheDate]-DateAdd("d",-Weekday(DateSerial(Year([TheDate])+2,Month([TheDate]),1)),DateSerial(Year([TheDate]),Month([TheDate]),1));

A table of holidays could easily be added. This solution requires zero code, just one table of dates and a couple queries.


Duane
Hook'D on Access
MS Access MVP

 

[spartansFC]

You lost me at cartesian query Duane. I'm so amazed at the help people give on this forum.

Alot of MajP's code and Duane's last query are a bit out of my league if i'm honest. I understand the first part of Duane's query, it's the Transform SQL statement where i go a bit blank.

I've got alot of copying and pasting to do in the next few days to get the form to match MajP's version.

Thanks again for all your help

Mikie

 

[dhookom]

This is a picture of the form built with a single line of code that requeries the subform after changing the combo box values.

Download the demo application file

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

Duane,
That is an eloquent solution. I can go into design view to see how you did it. A little beyond me, Xtabs are not my strong point. But at least I can follow. However, the form does not render for some reason. All I see is the header row, but the subform does not show. Can you look at it and repost if there is something with it?

 

[dhookom]

Thanks MajP. I probably would have written code rather than use conditional formatting but I wanted to avoid all code.

I downloaded the file to my work PC and it works as expected. I assume you are trusting the application so it can run the code. Nothing will display in the subform until after you select a ship to and year. Then you need to click the button to Refresh the subform.

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

I have never seen this before.
If I try to open it from the database window the mainform does not seem to render. The only thing visible is the subform (without) any data. It renders exactly as if opening just the subform. There may be some setting I have that is causing this.
But if I do this
Public Sub OpenFormTest()
DoCmd.OpenForm "frmActivitySchedule", , , , , acDialog
End Sub

it works.

 

[dhookom]

Interesting, what version of Access? I created the demo in 2007.

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

2010
This is what it looks like when opening the form. None of the main form seems to render

 

[dhookom]

I'll try this at home with Access 2010 to see what I get. Thanks for the heads up.

Duane
Hook'D on Access
MS Access MVP

 

[dhookom]

MajP,
The form displays fine in Access 2010 on another PC at work. What happens if you change the height of the subform control?

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

I tried changing the subform height no success. I tried setting the border style. But if I set the form to dialog in the properties it works.

 

[dhookom]

I just tried this at home on a different PC running Access 2010 and it displayed as expected.

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

I am sure it is some setting. I switched from tabs to overlapping screens, but that did not do anything either.

 

[spartansFC]

Thanks for both your help, so i'm going to use MajP's coding to produce the yearly calendar form but i also need to create another attendance form which i'm going to use Duane's xtab method.

The attendance form will have children's names as row's, with the days as column headings, it will just show a single month's days along the top of the form and i'll use the a combo box to select other months, so what i've got so far is:

My version of qcarDateShipTo

SELECT tblSessionsBuildNewPerm.lngChildID, [c_contacts.name1] & " " & [c_contacts.Name2] AS childsname, [qryChildrenSub10CurrentClubName.Name1] AS Clubname, tblDates.TheDate, tblDates.isHoliday, Year([TheDate]) AS Expr1
FROM tblDates, (tblSessionsBuildNewPerm INNER JOIN c_contacts ON tblSessionsBuildNewPerm.lngChildID = c_contacts.PID) INNER JOIN qryChildrenSub10CurrentClubName ON tblSessionsBuildNewPerm.lngClubsID = qryChildrenSub10CurrentClubName.PID
GROUP BY tblSessionsBuildNewPerm.lngChildID, [c_contacts.name1] & " " & [c_contacts.Name2], [qryChildrenSub10CurrentClubName.Name1], tblDates.TheDate, tblDates.isHoliday, Year([TheDate])
ORDER BY tblSessionsBuildNewPerm.lngChildID, tblDates.TheDate;

My version of qxtbActivitySchedule

TRANSFORM Max(Day([TheDate])) & Chr(13) & Chr(10) & Max([[b][COLOR=#EF2929]lngAMPMSession[/b][/color]]) & Chr(13) & Chr(10) & Min([IsHoliday]) AS Val
SELECT Year([TheDate]) AS YR, Month([TheDate]) AS MTH, qcarDateBookingTo.lngChildID, qcarDateBookingTo.Clubname, qcarDateBookingTo.childsname
FROM qcarDateBookingTo LEFT JOIN tblSessionsBuildNewPerm ON (qcarDateBookingTo.lngChildID = tblSessionsBuildNewPerm.lngChildID) AND (qcarDateBookingTo.TheDate = tblSessionsBuildNewPerm.dteSessionDate)
GROUP BY Year([TheDate]), Month([TheDate]), qcarDateBookingTo.lngChildID, qcarDateBookingTo.Clubname, qcarDateBookingTo.childsname
ORDER BY Year([TheDate]), Month([TheDate]), qcarDateBookingTo.Clubname, qcarDateBookingTo.childsname
PIVOT [TheDate]-DateAdd("d",-Weekday(DateSerial(Year([TheDate])+2,Month([TheDate]),1)),DateSerial(Year([TheDate]),Month([TheDate]),1)) In (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36);

so the xtab query works great, all the correct dates are shown but it doesn't seem to colour code the boxes based on the conditional formatting on the form which is done via:

expression is Right([3],2)="-1"

the only change i've made is on the TRANSFORM xtab you had customer ID whereas i have lngAMPMSession, the reason why i've used this is because i also want a second colour coding conditional format and was going to use this field to do it, lngAMPMSession comes from tblSessionType

lngSessionTypesID (Autonumber)
strSessionKey (text)
strSessionFullDesc (text)

1 B Booked
2 C Cancelled Session
6 T Training Day
9 Ex Extra Session

So have you any ideas why the conditional formatting isn't working on my amended version?

Mikie

 

[dhookom]

Does your tblDates have any records where IsHoliday is checked?

Duane
Hook'D on Access
MS Access MVP

 

[spartansFC]

my tblDates does have quite a few isHoliday checked boxes ticked. I did notice that when i set up the tblDates, the isHoliday criteria was set to True/False whereas yours was set to Yes/No. i did change that field setting but it hasn't made the holidays change a different colour on the form

 

[dhookom]

I would open the crosstab query and change the height of the rows so any "-1" would display in the third row like:
[pre]
24
A
-1
[/pre]

Duane
Hook'D on Access
MS Access MVP

 

[spartansFC]

Thanks Duane, i'll have a look tomorrow now. So does the following:

TRANSFORM Max(Day([TheDate])) & Chr(13) & Chr(10) & Max([lngAMPMSession]) & Chr(13) & Chr(10) & Min([IsHoliday]) AS Val

which is part of the crosstab query, does that line add the 3 rows to each text box? I think one of the problems is i don't understand
how things work so i can't fix them myself.

 

[dhookom]

Yes, there would be three rows in each value in the crosstab created by Chr(13) & Chr(10) which is a carriage return and line feed.

Duane
Hook'D on Access
MS Access MVP