Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Yearly calendar for attendance 11

Status
Not open for further replies.

oxicottin

Programmer
Jun 20, 2008
353
US
Hello, I have been using excel for employee attendance and im sick of tabs ect. I have been looking for a MS access database that shows 12 months on a form and on the form your able to select a day and enter a attendence entry ect. Does anyone know of anything free out there Or a sample DB I can get started on? calendar stuff is quite confusing so I want to find a sample to start from.

Thanks!

Thanks,
SoggyCashew.....
 
The way you have it now works for every year so how would I do it with the table and query?

So the advanatage of doing it on the fly is that you do not have to populate every holiday for every year. The disadvantage is that you can not add special cases or work specific rules.
So unfortunately you have to enter every holiday for every year. However you could pre load it using basically a modification of the function.

so if you want all the holidays from 1980 to 2050 run the following. You will need to create the table first. This will save a lot of work. If you have other specic cases then you could add them here (ex. you shut down every Mar 1 for inventory)

FillHolidays 1980, 2050

Code:
Public Sub FillHolidays(StartYear As Integer, EndYear As Integer)

  Dim HolidayDate As Date
  Dim CurrentYear As Integer

 
  For CurrentYear = StartYear To EndYear
      'New Years
      HolidayDate = CDate("01/01/" & CurrentYear)
      InsertHoliday HolidayDate, "New Years"
       'ML King 3rd Monday of Jan
       HolidayDate = DayOfNthWeek(CurrentYear, 1, 3, vbMonday)
       InsertHoliday HolidayDate, "Martin Luther King Day"
      'Presidents Day  3rd Monday of Feb
      HolidayDate = DayOfNthWeek(CurrentYear, 2, 3, vbMonday)
      InsertHoliday HolidayDate, "Presidents Day"
     'Memorial Day    Last Monday of May
      HolidayDate = LastMondayInMonth(CurrentYear, 5)
      InsertHoliday HolidayDate, "Memorial Day"
     'Independance Day
      HolidayDate = CDate("07/04/" & CurrentYear)
      InsertHoliday HolidayDate, "Independence Day"
     'Labor Day   1st Monday of Sep
      HolidayDate = DayOfNthWeek(CurrentYear, 9, 1, vbMonday)
      InsertHoliday HolidayDate, "Labor Day"
     'Columbus Day    2nd Monday of Oct
      HolidayDate = DayOfNthWeek(CurrentYear, 10, 2, vbMonday)
      InsertHoliday HolidayDate, "Columbus Day"
    ' Veteranss Day
    ' Although originally scheduled for celebration on November 11,
    ' starting in 1971 Veterans Day was moved to the fourth Monday of October.
    ' In 1978 it was moved back to its original celebration on November 11.
      HolidayDate = CDate("11/11/" & CurrentYear)
      InsertHoliday HolidayDate, "Verterans Day"
    'Thanksgiving Day  4th Thursday of Nov
      HolidayDate = DayOfNthWeek(CurrentYear, 11, 4, vbThursday)
      InsertHoliday HolidayDate, "Thanksgiving"
    'CHRISTMAS
      HolidayDate = CDate("12/25/" & CurrentYear)
      InsertHoliday HolidayDate, "Christmas"
   Next CurrentYear
End Sub
Public Sub InsertHoliday(HolidayDate As Date, HolidayName As String)
     Dim strSql As String
     strSql = "Insert into tblHolidays (HolidayDate, HolidayName) values (#" & Format(HolidayDate, "mm/dd/yyyy") & "# , '" & HolidayName & "')"
     Debug.Print strSql
     CurrentDb.Execute strSql
End Sub
 
MajP,our holdiays are:

New Years Day
Memorial day
Independance Day
Labor Day
Day Before Thanksgiving
Thanksgiving
Christmas Eve
Christmas

I would have to add a "Day Before Thanksgiving" and "Christmas Eve"

Thanks,
SoggyCashew.....
 
'Christmas Eve
HolidayDate = CDate("12/24/" & CurrentYear)
InsertHoliday HolidayDate, "Christmas Eve"
'Day Before Thanksgiving
HolidayDate = DayOfNthWeek(CurrentYear, 11, 4, vbThursday)
HolidayDate = HolidayDate - 1
InsertHoliday HolidayDate, "Day Before Thanksgiving
 
Ok, im having trouble getting this to work. I created the table tbl_Holidays and ran your code to populate the dates and names which worked great. Then I created a module called mod_FillHolidays with the semi copied Sub from mod_FillTextBoxes as instructed. I then created the query qry_FillHolidays as well.

The mod_FillHolidays Public Sub:

Code:
Public Sub FillHolidays(frm As Access.Form, theYear As Integer)

    Dim ctl As Access.Label
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim strMonth As String
    Dim intMonth As Integer
    Dim intDay As Integer
    Dim HolidayDate As Date
    Dim FirstDayOfMonth As Date
    Dim intOffSet As Integer

    strSql = "Select * from qry_FillHolidays where year(HolidayDate ) = " & theYear
    'Debug.Print strSql
    Set rs = CurrentDb.OpenRecordset(strSql)
    clearHolidays frm

    Do While Not rs.EOF
        HolidayDate = rs!HolidayDate
        strMonth = Format(HolidayDate, "mmm")
        intDay = Day(HolidayDate)
        intMonth = Month(HolidayDate)
        FirstDayOfMonth = getFirstOfMonth(theYear, intMonth)    'First of month
        intOffSet = getOffset(theYear, intMonth, vbSaturday)    'Offset to first label for month.
        Set ctl = frm.Controls("lbl" & strMonth & intDay + intOffSet)
        ctl.BackColor = HolidayDate
        rs.MoveNext
    Loop

End Sub

Public Sub clearHolidays(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
    Const ctlBackColor = 14211288    '-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
        For i = 1 To 37
            Set ctl = frm.Controls("lbl" & amonths(monthCounter - 1) & i)
            ctl.BackColor = ctlBackColor    '**********Added to reset the textbox backcolor
        Next i
    Next monthCounter
End Sub

Then in the FillMonthLabels module/Sub I changed the word IsHoliday to my new Sub name FillHolidays:

Code:
If FillHolidays(FirstDayOfMonth + (intDay - 1)) Then ctl.BackColor = 16760576    'Color holiday backcolor bright Blue

Now it not only dont show the holidays in the calendar it gives a error (Type Mismatch) on the + in the above code. Ideas?


SKYDRIVE TEST HOLIDAY DATABASE



Thanks,
SoggyCashew.....
 
In the old routine you checked every date to see if it was a holiday. Now you do it completely different. You fill the labels, and get rid of any code that deals with holidays. Then you call the fillholidays after FillMonthLabels completes.

So your code would look more like this.

fillMonthLabels(Me,cmboYear)
FillHolidays(Me,cmboYear)

Any event that use to call just FillMonthLabels would also call FillHolidays.
 
Majp, Ok that worked....

I used FillHolidays Me, CInt(cboYear.Value) under the FillMonthLabels everywhere needed in the calendar form and shortened the (Code1) FillHoliday module and then removed the (Code2)line and it works perfectly


CODE1
Code:
Public Sub FillHolidays(frm As Access.Form, theYear As Integer)

    Dim ctl As Access.Label
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim strMonth As String
    Dim intMonth As Integer
    Dim intDay As Integer
    Dim HolidayDate As Date
    Dim FirstDayOfMonth As Date
    Dim intOffSet As Integer

    strSql = "Select * from qry_FillHolidays where year(HolidayDate ) = " & theYear
    Set rs = CurrentDb.OpenRecordset(strSql)

    Do While Not rs.EOF
        HolidayDate = rs!HolidayDate
        strMonth = Format(HolidayDate, "mmm")
        intDay = Day(HolidayDate)
        intMonth = Month(HolidayDate)
        FirstDayOfMonth = getFirstOfMonth(theYear, intMonth)    'First of month
        intOffSet = getOffset(theYear, intMonth, vbSaturday)    'Offset to first label for month.
        Set ctl = frm.Controls("lbl" & strMonth & intDay + intOffSet)
        ctl.BackColor = 16760576    'Color holiday backcolor bright Blue
        rs.MoveNext
    Loop

End Sub

CODE2
Code:
If FillHolidays(FirstDayOfMonth + (intDay - 1)) Then ctl.BackColor = 16760576    'Color holiday backcolor bright Blue

Thanks,
SoggyCashew.....
 
Majp, I have been trying to display the number of vacation days each employee gets per years of service and if they bought a vacation it ads to the number of weeks. I also wanted to display hours used and hours left of vacation on the form. I am able to do this BUT I cant figure out how to get the query (qry_YearCalendarSubRight) to display totals all the time, it only starts to display anything if I enter a absence for an employee then it will display.

SKYDRIVE DATABASE 9

vr43.jpg






Thanks,
SoggyCashew.....
 
How is the sub form query set up? Is the subform linked to the combo? You can do that
Link master fields: [yourEmployeeCombo]
Link child fields: [employeeid]

If instead the subform is not linked but references a control, then you will have to requeries it often. Remember subforms load before the main form. So you might need something like
Me.yoursubforname.form.requery
 
Yes they are linked but that isnt the problem its the query. The query only brings up records that have to do with employees only if there is an entry for the year for them. I want it brought up for each employee even if no entry is entered.

Thanks,
SoggyCashew.....
 
You probably need a left join in your query, to include each employeeid
 
Yes left join worked I never did a left join so I had to play around with it but got it to work.

Majp, How would I go about getting the current days "Text Box" to have a yellow border? I messed around with the modules and cant figure out how to. Also, I ran a function that tells me how many controls I have on my form and there are 947 and I havent added much from the origional calendar.

Thanks,
SoggyCashew.....
 
Interesting, the 754 limit is well exceeded and according to MS that is still the limit. My guess is it went up some time back and never updated the help file..
MS said:
Number of controls and sections you can add over the lifetime of the form or report: 754

So to determine the txtbox or label that is today, the naming conventions are
txtJan1 .... txtJan37 where 1 - 37 are the columns.
So to find the month is easy. To find the column it is the same as loading the grid. Figure the day and figure the offset. If the first day falls in the fifth column then the offset is 5.
Once you have the month and column just concatenat
txt & Dec & 32 = txtDec32
Code:
Public Sub TestHilite()
  GetTodaysTextBox.BorderColor = vbYellow
End Sub
Public Function GetTodaysTextBox() As Access.TextBox
  Dim CurrentDay As Date
  Dim strMonth As String
  Dim offest As Integer
  Dim txtBxName As String
  CurrentDay = Date
  strMonth = Format(CurrentDay, "mmm")
  'Debug.Print strMonth
  Offset = getOffset(Year(CurrentDay), Month(CurrentDay), vbSaturday)
  'Debug.Print Offset
  txtBxName = "txt" & strMonth & Offset + Day(CurrentDay)
  'Debug.print TxtBxName
  Set GetTodaysTextBox = Forms("Frm_YearCalendar").Controls(txtBxName)
End Function
 
lol thanks Majp, I would have never got that.... Worked great!

Thanks,
SoggyCashew.....
 
Majp, I changed the look alot and im wanting to add a report that looks like a calendar just like I found in the example link below.

FOUND EXAMPLE CLAENDAR RPT




Thanks,
SoggyCashew.....
 
Is there a question there? Did you make each month calendar a subform or did you actually move around all the existing controls? The subform could have saved a lot of time if you were doing it from scratch. Since you already had the controls, would not have been as big of a deal.
 
Ok, I attached a sample DB with what I want to do with the report. There is a report button on the frm_YearCalendar
and it will open a report rpt_YearView. Im having two troubles,

1st, Lets say you selected Chad Z as supervisor and Z, Chad as employee and hit the "REPORT" button. it would bring
up a year calendar and page two shoud be all the absences but thats semi not the case. It does bring up the report
BUT it shows the record over and over 18 times BUT lets say I selected Chad Z as supervisor and C, Bob as employee it showes
2 pages. Why?

2nd, I am unable to figure out how to get the module mod_rptYearView to use the table tbluAbsenceCodes like you showed me for
the mod_FillTextBoxes module. I know its at the case area but I have no clue on how it would be written.


SKYDRIVE REPORT EXAMPLE DB

Thanks,
SoggyCashew.....
 
I am not seeing any of these problems
1st, Lets say you selected Chad Z as supervisor and Z, Chad as employee and hit the "REPORT" button. it would bring
up a year calendar and page two shoud be all the absences but thats semi not the case. It does bring up the report
BUT it shows the record over and over 18 times
I see a calendar with 9 correctly filled in absence codes, and page 2 is the correct list of the nine absences.
BUT lets say I selected Chad Z as supervisor and C, Bob as employee it showes
2 pages. Why?
1st page is the calendar, the second page is the list of their one absence. Looks correct to me.

2nd, I am unable to figure out how to get the module mod_rptYearView to use the table tbluAbsenceCodes like you showed me for
the mod_FillTextBoxes module. I know its at the case area but I have no clue on how it would be written
delete the case and replace with this
Code:
                  '// use these to generate permanent background color on the calendar report
                        .BackColor = GetBackColorCode(strCaption)
                        .ForeColor = GetTextColorCode(strCaption)
                    End If
                    
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    
                    datStartDate = DateAdd("d", 1, datStartDate)
                Else
                    .Caption = ""
                End If
            End With
        Next i
    End With
End Sub

'see new functions
 Public Function GetBackColorCode(strCode As String) As Long
   GetBackColorCode = DLookup("AbsenceColorCode", "tbluAbsenceCodes", "AbsenceCode = '" & strCode & "'")
 End Function

 Public Function GetTextColorCode(strCode As String) As Long
   GetTextColorCode = Nz(DLookup("AbsenceTextColorCode", "tbluAbsenceCodes", "AbsenceCode = '" & strCode & "'"), 0)

End Function
 
majp, the code word wonders thanks a million but I'm still having the issue with it showing a calendar and summary page for each absence. I see whats it doing but have no clue why. Lets say Chad Z has 9 absences and I open the report then it will show a page 1-2 nine times (one for each absence).....

Thanks,
SoggyCashew.....
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top