Yearly calendar for attendance 11

[oxicottin]

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.....

 

[oxicottin]

Majp, since I had to move the transparent command button that I had on the main form to the sub calendar form I set focus to it and it works.

frm.cmdSubFormTransButton.SetFocus
For i = 1 To 37
Set ctl = frm.Controls("lbl" & i)
Set ctlt = frm.Controls("txt" & i)



I had another question I have been trying to figure out.You know I have ben wanting to enlarge the main forms footer and the absence subform. Well im very close to what I am wanting except im stuck at a DCount. Basicly what im doing is im having an 2 images ontop each other (Visible No) in the subform and in the subforms "Current" event below I want to show the max and hide the min images if the DCount is >=3 and if its <=2 I want to hide both max and min images. The problem is sometimes there is no record for the DCount so its not hiding or anthing. I tried using IsNull = false and zero but nothing works if there is no record. How can I force the DCount to show a 0 records? Thanks!

Private Sub Form_Current()
    Dim SubRecCount As Integer
     
    SubRecCount = DCount("*", "qry_AbsenteeismPolicySummarySub") 'Counts records for selected employee
 
MsgBox SubRecCount

    If SubRecCount >= 3 Then    'Show the max button hides the min
        Me.imgMaxSub.Visible = True
        Me.imgMinSub.Visible = False
        
    ElseIf SubRecCount <= 2 Then 'Hides the buttons
        Me.imgMaxSub.Visible = False
        Me.imgMinSub.Visible = False
        
    ElseIf IsNull(SubRecCount) = False Then '
        Me.imgMaxSub.Visible = False
        Me.imgMinSub.Visible = False
    End If
End Sub

Thanks,
SoggyCashew.....

 

[MajP]

First of all your logic does not make sense. You never show the min button based on that logic.

The Dcount returns 0 not null, if there is no records. If it returned null you would know because you would get an error because you could not assign subRecCount = null.

Since 0 is less than 2 this should actually work, so there may be something else going on. My guess is that it is your currentevent. If a form has no records than I do not think the current event fires. I know the current event does not fire in an unbound form. Call it from when you requery the subform.


A better trick to toggle on/off is like this
Me.imgMaxSub.Visible = (SubRecCount >= 3) '
me.imgMinSub.Visible = (SubRecCount <= 2) '

So this part "(SubRecCount >= 3)", can return either true and false.

 

[oxicottin]

First of all your logic does not make sense. You never show the min button based on that logic.

I wasnt dont with the code, I was going to have the Min image visible once the subform was enlarged.

My guess is that it is your currentevent. If a form has no records than I do not think the current event fires. I know the current event does not fire in an unbound form. Call it from when you requery the subform.

I think it is that also because I would at least get a msgbox showing 0 if the SubRecCount fired but I dont get anything. You say call it from where you requery, which is the comboboxes ect and a few other places. Im not sure I know what you mean by "call it". Thanks!!!!!!



Thanks,
SoggyCashew.....

 

[MajP]

Every time you change employee combo and the year combo those subform requery. So in the change event of the combos add a call to showHide the the images instead of calling it from the current event.

 

[oxicottin]

Majp, I have been testing for a few weeks now and it has been working great for myself. I only needed it for myself and never thought to test changeing the supervisor I always just opened the DB selected a supervisor then started selecting employees, I never then went and tried to select a diferent supervisor and what happens when I do is it doenst clear the calendar, it still shows the last employee I was on.

What would I use in the what VBA would I use in the cboSupervisors AfterUpdate Event that would clear the subform calendar? Im sure its already in a module I have but what....

Thanks?

Thanks,
SoggyCashew.....

 

[oxicottin]

If I use the below code it will clear the subforms textboxes but is it the correct way?

clearSubFormTextBoxes Me.SubFormJan.Form
clearSubFormTextBoxes Me.SubFormFeb.Form
clearSubFormTextBoxes Me.subformMar.Form
clearSubFormTextBoxes Me.subFormApr.Form
clearSubFormTextBoxes Me.SubFormMay.Form
clearSubFormTextBoxes Me.SubFormJun.Form
clearSubFormTextBoxes Me.subFormJul.Form
clearSubFormTextBoxes Me.subFormAug.Form
clearSubFormTextBoxes Me.subFormSep.Form
clearSubFormTextBoxes Me.SubFormOct.Form
clearSubFormTextBoxes Me.subFormNov.Form
clearSubFormTextBoxes Me.subFormDec.Form

Thanks,
SoggyCashew.....

 

[oxicottin]

Ok, after messing with the code I posted above I think it works prety good unless there is a better way please let me know.... Here is what I came up with. Thanks!

Private Sub cboSupervisor_AfterUpdate()
  
If IsNull(Me.cboEmployee) = True Then
'Theres no data in cboEmployee
     Me.cboEmployee.Enabled = True
     Me.cboEmployee.Requery 'Just incase you went back and reselected another supervisor without selecting and employee
     Caption = "Absentee Tracker" 'Clears years of service and displays tracker untill employee is selected
Else
'There is data in cboEmployee lets clear it
     Me.cboEmployee = Null
     Me.cboEmployee.Enabled = True
     Me.cboEmployee.Requery
     Caption = "Absentee Tracker" 'Clears years of service and displays tracker untill employee is selected
     'Clear all subForm Calendars using (mod_FillTextBoxes) (Public Sub clearSubFormTextBoxes)
     clearSubFormTextBoxes Me.subFormJan.Form
     clearSubFormTextBoxes Me.SubFormFeb.Form
     clearSubFormTextBoxes Me.subformMar.Form
     clearSubFormTextBoxes Me.subFormApr.Form
     clearSubFormTextBoxes Me.SubFormMay.Form
     clearSubFormTextBoxes Me.SubFormJun.Form
     clearSubFormTextBoxes Me.subFormJul.Form
     clearSubFormTextBoxes Me.subFormAug.Form
     clearSubFormTextBoxes Me.subFormSep.Form
     clearSubFormTextBoxes Me.SubFormOct.Form
     clearSubFormTextBoxes Me.subFormNov.Form
     clearSubFormTextBoxes Me.subFormDec.Form
End If

End Sub

Thanks,
SoggyCashew.....

 

[MajP]

That is exactly correct. but for portability of the code, I would put the clears into a single procedure and reuse the variables that were created for the subforms.

Public Sub ClearAllTextBoxes
     clearSubFormTextBoxes sFrmJan
     clearSubFormTextBoxes sFrmFeb
     clearSubFormTextBoxes sFrmMar
     clearSubFormTextBoxes sFrmApr
     clearSubFormTextBoxes sFrmMay
     clearSubFormTextBoxes sFrmJun
     clearSubFormTextBoxes sFrmJul
     clearSubFormTextBoxes sFrmAug
     clearSubFormTextBoxes sFrmSep
     clearSubFormTextBoxes sFrmOct
     clearSubFormTextBoxes sFrmNov
     clearSubFormTextBoxes sFrmDec
End Sub

We defined at the class level variables for each of the subforms. Makes the code a little easier to rewrite (shorter). You have similar procedures for adding textbox values for employees, and for adding all the month labels. Now you can call this from other locations. There may be other events or instances where you need to do this. Then replace your clears with the single line

ClearAllTextBoxes

 

[oxicottin]

Majp, Here is another thought. If an employee lets say came in late then worked for part of the day then left early then that would mean I would have to enter 2 absences or instances into thier atendance calendar and right now you cna only do one. What would be a goood way to aproch this so I can show two instances in my calendar? I dont ever think there will be more than two in a day.

Thanks!

Thanks,
SoggyCashew.....

 

[MajP]

You would have to modify your pop to either have an add new button, to add a second record and just move your form to a new record. The problem wiht that is you can not see how many codes you have listed. Or design the form with a master form, subform. In the master you would have the date, and employee information, the subform would be the combo to pull down the codes and a textbox for the times. This way you could see all the codes for that date. This would be easy to do, but takes a little thinking. The main form would not be bound, and you would pass the employeeID and date using the open args. I think that is how it is done already. Now link the subform date field, and employee ID field using the child master relationship. This is a trick that many people do not know. You can link a subform field to a forms field, or to a control.

Something like
link Master Fields: txtBoxEmployeeID; txtBoxAbsenceDate
link Child Fields: EmployeeID, AbsenceDate

Since you pass to the main form the EmployeeID, you can show the employee name and other information using a Dlookup on the main form.


So now that you can add, edit, and delete multiple absences for an employee for a given day. To display you would modify it a little. Just have to read all the absences for the day and put them into a string.
current Code

     strSql = "Select * from qry_FillTextBoxes where EmployeeID = " & EmpId    'Query that finds the absence Year() by employeeID
    strSql = strSql & " AND year(AbsenceDate) = " & TheYear & " AND Month(AbsenceDate) = " & TheMonth
    Set rs = CurrentDb.OpenRecordset(strSql)
    clearSubFormTextBoxes frm    'Uses(clearTextBoxes)Sub to clear the textbox grid on the frm as (frm_YearCalendar)

    Do While Not rs.EOF
        AbsenceDate = rs!AbsenceDate
        AbsenceCode = rs!AbsenceCode
        AbsenceTextColorCode = rs!AbsenceTextColorCode
        AbsenceColorCode = rs!AbsenceColorCode
        'strMonth = Format(AbsenceDate, "mmm")
        intDay = Day(AbsenceDate)
        'IntMonth = Month(AbsenceDate)
        FirstDayOfMonth = getFirstOfMonth(TheYear, TheMonth)    'First of month
        intOffSet = getOffset(TheYear, TheMonth, vbSaturday)    'Offset to first label for month.
        Set ctl = frm.Controls("txt" & intDay + intOffSet)
        ctl.Value = AbsenceCode    'Displays the text or absencecode in the textbox to whats indicated in tbluAbsenceCodes
        ctl.BackColor = AbsenceColorCode    'Changes the texbox(s) backcolor to whats indicated in tbluAbsenceCodes
        ctl.ForeColor = AbsenceTextColorCode    'Changes the texbox(s) text to whats indicated in tbluAbsenceCodes
        rs.MoveNext
    Loop

So first get a recordset of all days that have absences then use that to get a new recordset for each day.

    strSql = "Select distinct AbsenceDate from qry_FillTextBoxes where EmployeeID = " & EmpId    'Query that finds the absence Year() by employeeID
    strSql = strSql & " AND year(AbsenceDate) = " & TheYear & " AND Month(AbsenceDate) = " & TheMonth
    Debug.Print strSql
    Set rs = CurrentDb.OpenRecordset(strSql)
    clearSubFormTextBoxes frm    'Uses(clearTextBoxes)Sub to clear the textbox grid on the frm as (frm_YearCalendar)
    'loop the days with absences for that month
    Do While Not rs.EOF
        AbsenceDate = rs!AbsenceDate
        strSql = "Select * from qry_FillTextBoxes where EmployeeID = " & EmpId    'Query that finds the absence Year() by employeeID
        strSql = strSql & " AND absenceDate = #" & AbsenceDate & "#"
        Set rsDay = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
        Debug.Print strSql
        Do While Not rsDay.EOF
            AbsenceCode = rsDay!AbsenceCode
            Debug.Print " in loop " & AbsenceCode
            Debug.Print rsDay.AbsolutePosition
            If strCodes = "" Then
             strCodes = AbsenceCode
           Else
             strCodes = strCodes & "," & AbsenceCode
           End If
           AbsenceTextColorCode = rsDay!AbsenceTextColorCode
           AbsenceColorCode = rsDay!AbsenceColorCode
           rsDay.MoveNext
        Loop
        
           Debug.Print strCodes & EmpId
          'Not sure what to do here with the colors, because you can only have one set per textbox
           intDay = Day(AbsenceDate)
           FirstDayOfMonth = getFirstOfMonth(TheYear, TheMonth)    'First of month
           intOffSet = getOffset(TheYear, TheMonth, vbSaturday)    'Offset to first label for month.
           Set ctl = frm.Controls("txt" & intDay + intOffSet)
           ctl.Value = strCodes  'Displays the text or absencecode in the textbox to whats indicated in tbluAbsenceCodes
           ctl.BackColor = AbsenceColorCode    'Changes the texbox(s) backcolor to whats indicated in tbluAbsenceCodes
           ctl.ForeColor = AbsenceTextColorCode    'Changes the texbox(s) text to whats indicated in tbluAbsenceCodes
           strCodes = ""
        rs.MoveNext
    Loop

Not sure how you want to color this, because you cannot dual color. Maybe you could come up with a color for more than one absence.

 

[oxicottin]

Majp, Im thinking maybe having two text boxes for each date because I want to be able to display two diferent colors on the calendar. I tried to follow your directions and imedently got lost.

You would have to modify your pop

Are you talking about frm_CalendarInputBox? if so I tried to allow it to add a second record but it wont keep the date. I would rather just have two sections like what I have now in my frm_CalendarInputBox but the first section would be for one textbox thats on the calendars date and the other for the others textbox on the same date.


This evening after work EST I will upload a fully working DB of what I have so far because I have also added the hours into the textbox which was needed.


Thanks!

Thanks,
SoggyCashew.....

 

[MajP]

If you go with the two set of textboxes there will be a lot of modifications throughout the database, forms, and code.
The better coice may be to change the format choice of the textboxes from "Plain Text" to "Rich Text".
Then if there are two or more records you could then apply different formatting (text color and text highlight) to each absence.

So what you would have to do is select all your textboxes and under the data tab change the
"Text Format " from "Plain Text" to "Rich Text"
Now as you build your text string you are going to wrap it in html tags. To make things easier put the tags in the table.
So here is the string for the word "absence One" with red background and black text. (Absence One represents one of your codes)

<font color="#0C0C0C" style="BACKGROUND-COLOR:#FF0000">Absence One</font>

So if these tags are kept in the table your code would look something like

      Do While Not rsDay.EOF
            AbsenceCode = rsDay!AbsenceCode
            AbsenceColorTag = rsDay!AbsenceColorTag "The html tag stored in the table
            AbsenceCode = absenceColorTag & AbsenceCode & "</font>"
           If strCodes = "" Then
             strCodes = AbsenceCode
           Else
             strCodes = strCodes & "," & AbsenceCode
           End If
           AbsenceTextColorCode = rsDay!AbsenceTextColorCode
           AbsenceColorCode = rsDay!AbsenceColorCode
           rsDay.MoveNext
        Loop
        'I think you actually need to wrap it with a <div> </div>
        strCodes = "<div>" & strCodes & "</div>"

The final string for two codes, first is black text red background, second is white text blue background would look like this:

<div>
<font color="#0C0C0C" style="BACKGROUND-COLOR:#FF0000">Absence One</font>
<font color=white style="BACKGROUND-COLOR:#000080"> Absence Two</font>
</div>

This may not look as good because only the text is highlighted not the whole text box, but the calendar will look better. So what you could do is if there is only one record for the day is choose to highlight the wholed textbox, if more than one use the richtext formats.

So you could do a recordset count first

if rsDay.recordcount > 1 then
       Do While Not rsDay.EOF
            AbsenceCode = rsDay!AbsenceCode
            AbsenceColorTag = rsDay!AbsenceColorTag "The html tag stored in the table
            AbsenceCode = absenceColorTag & AbsenceCode & "</font>"
           If strCodes = "" Then
             strCodes = AbsenceCode
           Else
             strCodes = strCodes & "," & AbsenceCode
           End If
           AbsenceTextColorCode = rsDay!AbsenceTextColorCode
           AbsenceColorCode = rsDay!AbsenceColorCode
           rsDay.MoveNext
        Loop
else
       Do While Not rsDay.EOF
            AbsenceCode = rsDay!AbsenceCode
             If strCodes = "" Then
             strCodes = AbsenceCode
           Else
             strCodes = strCodes & "," & AbsenceCode
           End If
           AbsenceTextColorCode = rsDay!AbsenceTextColorCode
           AbsenceColorCode = rsDay!AbsenceColorCode
           rsDay.MoveNext
        Loop
end if

 

[MajP]

It would look something more like this
If more than one record than you could still apply a generic background to the textbox (maybe light gray) and then do the tagging.

 

[MajP]

Doing it that way instead of the two set of textboxes would be minutes of work instead of many hours of work.
Also I have built a similar version in Visual Studio using vb.net. So this is my idea for having the ability to do multiple codes per day.

This makes it nice to add, edit, delete and see all the activities for the day.

 

[oxicottin]

Majp, below is the version I have been using. I will try to get what your talking about working but I have never herd of using html so its new to me. You say to change to rich text in my popup but I only have two text boxes. Anyways here is the link

ATTENDANCE v3 (Public Version)

Thanks,
SoggyCashew.....

 

[MajP]

No the rich text is the calendar, so you can high light multiple strings in one textbox. I actually have it working and will post it soon.

 

[oxicottin]

Oh Ok.... I will wait for your example so I can try to incorperate into mine. Thanks!

Thanks,
SoggyCashew.....

 

[MajP]

Here is the link to the file. It also includes a form that will allow you to edit text and then get the proper tags for that format. "RichTextHelper"

http://www.4shared.com/file/fG0NbDNlce/MajP_Attendance_-_RichText.html

Pretty cool, I have to admit.

 

[oxicottin]

Majp, Yes it is very cool... I set mine up so each absence is on ists own new row and I will only ever need two max so mine would look like:

VFMLA
PD

I am trying to figure out how to extend the color for the full row using html in the caleder but its not working. Here is what I did.

1) In the tbluAbsenceCodes/AbsencColorTag I added ; display:block; so it now looks like:
<font color=white style='BACKGROUND-COLOR:#458B00; display:block;'>

I then added <br> to the Public Sub FillSubFormTextBoxes so it forces a line.

If strCodes = "" Then
                AbsenceCode = AbsenceColorTag & AbsenceCode & "<br></font>"
                strCodes = AbsenceCode
              Else
                AbsenceCode = AbsenceColorTag & " " & AbsenceCode & "<br></font>"

I run it and check the Debug.Print you had and it shows up correctly but it just doesnt work.

<div>
<font color=white style='BACKGROUND-COLOR:#458B00; display:block;'>V<br></font> 
<font color=black style='BACKGROUND-COLOR:#FFA500; display:block;'>FMLA<br></font>
</div>

Thanks,
SoggyCashew.....

 

[MajP]

so build a function to pad the string to make it appear to fill the whole block.
I figure about 9 total characters
Since you want it centered you need some spaces on the front and on the back.

Public Function PadString(strText As String, TotalLength As Integer) As String
  Dim textlength As Integer
  Dim spacesToPad As Integer
  Dim frontPad As Integer
  Dim backPad As Integer
  textlength = Len(strText)
  'since the string is centered in the box need to pad half to front and half to back
  If textlength < TotalLength Then
    spacesToPad = TotalLength - textlength
    frontPad = spacesToPad \ 2
    backPad = spacesToPad - frontPad
    strText = Space(frontPad) & strText & Space(backPad)
  End If
  PadString = strText
End Function

so pass in "PD" and you would get something like " PD "
unfortunely to make this work well, you need to then left align the ctl.

So the updated code looks like

Public Sub FillSubFormTextBoxes(frm As Access.Form, EmpId As Long, TheYear As Integer, TheMonth As Integer)
'==================================================================================================
'//Fills the grids textbox(s) with data and color on the correct date an absence was entered on.
'==================================================================================================
    Dim ctl As Access.TextBox
    Dim rs As DAO.Recordset
    Dim rsDay As DAO.Recordset
    Dim strSql As String
    Dim strMonth As String
    Dim intDay As Integer
    Dim FirstDayOfMonth As Date
    Dim intOffSet As Integer
    Dim strCodes As String
    Dim AbsenceDate As Date   'Field in tbl_YearCalendar
    Dim AbsenceCode As String   'Field in tbluAbsenceCodes
    Dim AbsenceColorCode As String   'Field in tbluAbsenceCodes - Added to color textbox(s)
    Dim AbsenceTextColorCode As String   'Field in tbluAbsenceCodes - Added to color textbox(s)text
    Dim AbsenceColorTag As String
    On Error GoTo errlbl:
    strSql = "Select distinct AbsenceDate from qry_FillTextBoxes where EmployeeID = " & EmpId    'Query that finds the absence Year() by employeeID
    strSql = strSql & " AND year(AbsenceDate) = " & TheYear & " AND Month(AbsenceDate) = " & TheMonth
    'Debug.Print strSql
    Set rs = CurrentDb.OpenRecordset(strSql)
    clearSubFormTextBoxes frm    'Uses(clearTextBoxes)Sub to clear the textbox grid on the frm as (frm_YearCalendar)
    'loop the days with absences for that month
    Do While Not rs.EOF
       AbsenceDate = rs!AbsenceDate
       strSql = "Select * from qry_FillTextBoxes where EmployeeID = " & EmpId    'Query that finds the absence Year() by employeeID
       strSql = strSql & " AND absenceDate = #" & AbsenceDate & "#"
       Set rsDay = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
       'Debug.Print strSql
       rsDay.MoveLast
       rsDay.MoveFirst
       If rsDay.RecordCount > 1 Then
          AbsenceColorCode = 16777215
          AbsenceTextColorCode = 1
          Do While Not rsDay.EOF
             AbsenceCode = rsDay!AbsenceCode
             AbsenceColorTag = rsDay!AbsenceColorTag 'The html tag stored in the table
             If strCodes = "" Then
                'Pad your string
                AbsenceCode = PadString(AbsenceCode, 9)
                AbsenceCode = AbsenceColorTag & AbsenceCode & "</font>"
                strCodes = AbsenceCode
              Else
                AbsenceCode = PadString(AbsenceCode, 9)
                'Here is the location for the Break
                AbsenceCode = AbsenceColorTag & "<br>" & AbsenceCode & "</font>"
                strCodes = strCodes & AbsenceCode
              End If
              rsDay.MoveNext
           Loop
           strCodes = "<div>" & strCodes & "</div>"
           Debug.Print strCodes
       Else
          AbsenceCode = rsDay!AbsenceCode
          strCodes = AbsenceCode
          AbsenceTextColorCode = rsDay!AbsenceTextColorCode
          AbsenceColorCode = rsDay!AbsenceColorCode
          rsDay.MoveNext
       End If
       intDay = Day(AbsenceDate)
       FirstDayOfMonth = getFirstOfMonth(TheYear, TheMonth)    'First of month
       intOffSet = getOffset(TheYear, TheMonth, vbSaturday)    'Offset to first label for month.
       Set ctl = frm.Controls("txt" & intDay + intOffSet)
       'change the alignment if it has more than one code
       If rsDay.RecordCount > 1 Then
         ctl.TextAlign = 1
       Else
         ctl.TextAlign = 2
       End If
       ctl.Value = strCodes  'Displays the text or absencecode in the textbox to whats indicated in tbluAbsenceCodes
       ctl.BackColor = AbsenceColorCode    'Changes the texbox(s) backcolor to whats indicated in tbluAbsenceCodes
       ctl.ForeColor = AbsenceTextColorCode    'Changes the texbox(s) text to whats indicated in tbluAbsenceCodes
       strCodes = ""
       rs.MoveNext
    Loop
    Exit Sub
errlbl:
    ' Debug.Print "Form is Nothing = " & frm Is Nothing
     Debug.Print Err.Number & " " & Err.Description & " in Fill textboxes"

End Sub

FYI,
You will have to resize all the textboxes in the month calendar subform or you will not be able to see the second code.
Then you will have to resize each of the subform controls to fit the larger month calendar.
However, this is why using the subform is such an easier approach. Also you may want to change the font to a fixed width font (each character the same size) to make the padding equal. Calibri is not fixed width so letters and spaces are different sizes.