Any help is greatly appreciated:
Im using code i found on the web to integrate in my application.
I keep getting this error: The Key is already associated with an element in this collection
associated with this line:
Full Code below:
Im using code i found on the web to integrate in my application.
I keep getting this error: The Key is already associated with an element in this collection
associated with this line:
Code:
colCalendarDates1.Add strCode1, strDate1
Full Code below:
Code:
Option Compare Database
Option Explicit
'// AUTHOR: Dom DXecutioner (Dominick G. Hernandez)
Private m_strCTLLabel As String
Private m_strCTLLabelHeader As String
Private colCalendarDates1 As Collection
Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate1 As String
Dim strCode1 As String
Dim i As Integer
Set rs = CurrentDb.OpenRecordset("qry_employeeAttendance", dbOpenDynaset)
Set colCalendarDates1 = New Collection
With rs
If (Not .BOF) Or (Not .EOF) Then
.MoveLast
.MoveFirst
End If
If .RecordCount > 0 Then
For i = 1 To .RecordCount
strDate1 = .Fields("attendanceDate")
strCode1 = .Fields("statusCode")
colCalendarDates1.Add strCode1, strDate1
.MoveNext
Next i
End If
.Close
End With
'// return date collection
Set rs = Nothing
End Function
Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report
m_strCTLLabel = "labelCELL"
m_strCTLLabelHeader = "labelDAY"
'// load dates into our collection
Call getCalendarData
With theReport
'// get the first month of the year
datStart = "1/1/" & Year(Date)
'// add the year to the report's label
.Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & " iCalendar"
For i = 1 To 12
'// set pointer to subreport control hosting the mini-calendar
Set rptControl = .Controls("childCalendarMonth" & i).Report
'// run procedure to populate control with it's respective year
Call loadReportCalendar(rptControl, datStart)
'// reset and obtain first day of the following month
datStart = DateAdd("m", 1, datStart)
Next i
End With
'// clean up
Set colCalendarDates1 = Nothing
Set rptControl = Nothing
End Sub
Public Sub loadReportCalendar(theReport As Report, Optional StartDate As Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
datStartDate = StartDate
intWeekDay = Weekday(datStartDate)
With theReport
.Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
'// change the day label's backcolor if necessary
If Not (IsMissing(theHeaderColor)) Then
For i = 1 To 7
.Controls("labelDayHeader" & i).BackColor = theHeaderColor
Next
End If
For i = 1 To 42
With .Controls(m_strCTLLabel & i)
If (i >= intWeekDay) And (Month(StartDate) = Month(datStartDate)) Then
If (datStartDate = Date) Then
.BackColor = vbYellow
End If
'// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
On Error Resume Next
Dim strCaption As String
Dim strKey As String
strKey = datStartDate
strCaption = ""
strCaption = colCalendarDates1.Item(strKey)
colCalendarDates1.Remove strKey
If strCaption = vbNullString Then
.Caption = Day(datStartDate)
.Bold = False
Else
.Caption = strCaption
.Bold = True
Select Case strCaption
Case "v"
.BackColor = vbBlue
Case "s"
.BackColor = vbRed
Case "l"
.BackColor = 39423
End Select
.ForeColor = vbWhite
End If
'// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
datStartDate = DateAdd("d", 1, datStartDate)
Else
.Caption = ""
End If
End With
Next i
End With
End Sub