Help with Leave Calendar database please

[zbratsberg]

Trying to modify this calendar database to track employee leave. I need the calendar form (frmCalendar) to show all employee leave on the calendar using the "Show All" command button on click event. This works if I specify a uID (UserID from employee table) in the code, but only for that specific employee. I need all employees at the same time up on the calendar so I can see if there is more than one employee off on any given day.

Events or leave is populated on the form through "Private Sub DisplayEvents" and the mdlCalendar module. Any help would be appreciated. Thank You.

Using Access 2010

[ssanfu]

I need the calendar form (frmCalendar) to show all employee leave on the calendar using the "Show All"

This was relatively easy..... but it *might* require a lot of other code changes.
Because there is a global variable for the user ID, when you click on the "View All" button, double clicking on a day list box won't open the form "frmAppointment". Actually, it is because I set the clobal variable "uID" to 0 (zero).
But you can see if there are multiple leave types on a day.

This could be fixed, but..... it is late....

So the fix:

I added a new sub named "DisplayAllEvents". (The lines I added/changed are in blue)

Private Sub DisplayAllEvents()
    On Error GoTo DisplayAllEvents_Err

    Dim calEvents As Collection
    Dim cEvent As Variant
    Dim tempStr As String
    Dim parApt As String
    Dim intDay As Integer    'Number box the first day lands on.
    Dim tmpd As Date

    Dim ctlList As ListBox
    Dim x As Integer
    Dim lngUserID As Long

    Me.cmbMonth.Value = intMonth
    Me.txtYear.Value = intYear
    intDay = -(1 - (Weekday(DateSerial(intYear, intMonth, 1))))

    Set ctlList = Me.lstUser
    Set calEvents = New Collection

    'loop through the emp list box
    For x = 0 To ctlList.ListCount - 1
        '        Debug.Print ctlList.ItemData(x)
        lngUserID = ctlList.ItemData(x)
        Set calEvents = GetEvents(DateSerial(intYear, intMonth, 1), DateSerial(intYear, intMonth + 1, 0), lngUserID)

        If calEvents.Count > 0 Then
            For Each cEvent In calEvents
                tempStr = cEvent.EventID & ";" & GetUserInfo(lngUserID) & " - " & Left(cEvent.EventType, 20) & " - " & (cEvent.Hours)
                tmpd = cEvent.EventDate
                Me.Controls("Day" & (intDay + Day(cEvent.EventDate))).AddItem tempStr
            Next cEvent
        End If

    Next

DisplayAllEvents_End:
    On Error GoTo 0
    Set calEvents = Nothing
    Exit Sub

DisplayAllEvents_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number
    Resume DisplayAllEvents_End
End Sub

Then I modified the code for the button "cmdViewAll":

Private Sub cmdViewAll_Click()
    '        uID = 0 
    '        RefreshForm

    uID = 0   'clear the global user ID
    Me.lstUser = Null   ' clear the emp list box
    SetDates        ' added this line
    DisplayHolidays      ' added this line
    DisplayAllEvents   'call to new sub
End Sub

This is very interesting. I'm going to have to study this dB and maybe see if I can fix the "DayXX" list box problem without messing up everything else.

[zbratsberg]

Absolutely perfect !!! I could not get my head wrapped around this. Thank You !!!