Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Private Sub Updateflxgrd()
- Dim cols As Integer, rows As Integer, rs As New Recordset, hw As New Recordset, weekends(31) As Boolean, holidays(31) As Boolean, Absense(31) As String, cnn As New connection, temp As String, weekdays As Date, dinmonth, atyear, atmonth, grdrows, daycol As Long, Where As String
- Dim color_holiday(2) As Long, color_sickness(2) As Long, color_auth(2) As Long, color_biz(2) As Long, color_comp(2) As Long, color_ber(2) As Long, color_mat(2) As Long, color_ind(2) As Long, color_late(2) As Long, color_matl(2) As Long, color_msus(2) As Long, color_pat(2) As Long, color_tra(2) As Long, color_una(2) As Long, color_work(2) As Long, color_unex(2) As Long
- Dim BackColorList() As String, ForeColorList() As String
- Progress_Msg "Processing Absense Data", False
- atyear = cmbYear
- atmonth = cmbMonth
- dinmonth = Day(DateSerial(atyear, atmonth + 1, 0))
- Set cnn = CurrentProject.AccessConnection
- rs.Open "SELECT * FROM tab_at_setup_attendance_codes", cnn, adOpenStatic, adLockReadOnly
- While Not rs.EOF
- If Not IsNull(rs!forecolor) Then
- Select Case rs!codeid
- Case "A"
- color_auth(1) = rs!forecolor
- color_auth(2) = rs!backcolor
- Case "B"
- color_biz(1) = rs!forecolor
- color_biz(2) = rs!backcolor
- Case "C"
- color_comp(1) = rs!forecolor
- color_comp(2) = rs!backcolor
- Case "D"
- color_ber(1) = rs!forecolor
- color_ber(2) = rs!backcolor
- Case "E"
- color_mat(1) = rs!forecolor
- color_mat(2) = rs!backcolor
- Case "H"
- color_holiday(1) = rs!forecolor
- color_holiday(2) = rs!backcolor
- Case "I"
- color_ind(1) = rs!forecolor
- color_ind(2) = rs!backcolor
- Case "L"
- color_late(1) = rs!forecolor
- color_late(2) = rs!backcolor
- Case "M"
- color_matl(1) = rs!forecolor
- color_matl(2) = rs!backcolor
- Case "N"
- color_msus(1) = rs!forecolor
- color_msus(2) = rs!backcolor
- Case "P"
- color_pat(1) = rs!forecolor
- color_pat(2) = rs!backcolor
- Case "S"
- color_sickness(1) = rs!forecolor
- color_sickness(2) = rs!backcolor
- Case "T"
- color_tra(1) = rs!forecolor
- color_tra(2) = rs!backcolor
- Case "U"
- color_una(1) = rs!forecolor
- color_una(2) = rs!backcolor
- Case "W"
- color_work(1) = rs!forecolor
- color_work(2) = rs!backcolor
- Case "X"
- color_unex(1) = rs!forecolor
- color_unex(2) = rs!backcolor
- End Select
- End If
- rs.MoveNext
- Wend
- rs.Close
- For daycol = 1 To dinmonth
- weekends(daycol) = False
- holidays(daycol) = False
- If Weekday(DateSerial(atyear, atmonth, daycol)) = 1 Or Weekday(DateSerial(atyear, atmonth, daycol)) = 7 Then
- weekends(daycol) = True
- Else
- weekends(daycol) = False
- End If
- Next daycol
- data = DateSerial(atyear, atmonth, dinmonth)
- data = CDate(DateSerial(atyear, atmonth, 1))
- data = "SELECT DateofHoliday FROM tab_at_attendance_holidays WHERE DateofHoliday >= #" & atyear & "/" & atmonth & "/" & 1 & "# And DateofHoliday <= #" & atyear & "/" & atmonth & "/" & dinmonth & "#"
- rs.Open data, cnn, adOpenStatic, adLockReadOnly '"SELECT DateofHoliday FROM tab_at_attendance_holidays WHERE DateofHoliday >= CONVERT(datetime, '" & DateSerial(atyear, atmonth, 1) & "', 101) And DateofHoliday <= CONVERT(datetime, '" & DateSerial(atyear, atmonth, dinmonth) & "', 101)", cnn, adOpenStatic, adLockReadOnly
- While Not rs.EOF
- holidays(Day(rs!DateofHoliday)) = True
- rs.MoveNext
- Wend
- rs.Close
- cols = 1 + 31
- With Me.grdAttendenceSummary
- .Clear
- .cols = cols
- .rows = 2
- .FixedRows = 1
- .FixedCols = 0
- .ColWidth(0) = 155
- .RowHeight(0) = 300
- .FocusRect = flexFocusHeavy
- .SelectionMode = flexSelectionByRow
- .row = 0
- col_ix = 0
- .TextArray(col_ix) = ""
- .ColWidth(col_ix) = 2500
- .ColAlignment(col_ix) = flexAlignLeftCenter
- For titcols = 0 To dinmonth - 1
- col_ix = 1 + titcols
- .TextArray(col_ix) = str(1 + titcols)
- .ColWidth(col_ix) = 340
- .ColAlignment(col_ix) = flexAligncentercenter
- Next titcols
- For titcols = dinmonth - 1 To 30
- col_ix = 1 + titcols
- .ColWidth(col_ix) = 300
- Next titcols
- .RowHeight(1) = 0
- If Defined(cmbDepartment) And Not cmbDepartment = -1 Then
- Where = "WHERE deptid = " & cmbDepartment
- End If
- Where = Where & IIf(Defined(Where), " AND ", "WHERE ") & " tr_terminated != '1'"
- If Defined(cmdLocation) And Not cmdLocation = -1 Then
- Where = Where & IIf(Defined(Where), " AND ", "WHERE ") & "locationid = " & cmdLocation
- End If
- Dim sql As String
- sql = "SELECT * FROM tab_ps_personnel_details " & Where & " ORDER BY surname"
- rs.Open sql, cnn, adOpenStatic, adLockReadOnly
- While Not rs.EOF
- For daycol = 1 To dinmonth
- Absense(daycol) = ""
- Next daycol
- sql = "SELECT * FROM cqry_at_absence_with_code WHERE payrollno = " & rs!payrollno & " AND cal_date >= CONVERT(datetime, '" & DateSerial(atyear, atmonth, 1) & "', 103) And cal_date <= CONVERT(datetime, '" & DateSerial(atyear, atmonth, dinmonth) & "', 103)"
- hw.Open sql, cnn, adOpenStatic, adLockReadOnly
- ReDim ForeColorList(31) As String
- ReDim BackColorList(31) As String
- While Not hw.EOF
- Absense(Day(hw!cal_date)) = hw!translation_code
- ForeColorList(Day(hw!cal_date)) = hw!forecolor
- BackColorList(Day(hw!cal_date)) = hw!backcolor
- hw.MoveNext
- Wend
- hw.Close
- abstring = Join(Absense, vbTab)
- .AddItem rs!surname & ", " & rs!forename & abstring
- .row = .rows - 1
- For daycol = 1 To dinmonth
- .col = daycol
- If weekends(daycol) Then
- .cellbackcolor = 3068726
- End If
- Select Case .Text
- Case "A"
- .cellbackcolor = color_auth(2)
- .CellForeColor = color_auth(1)
- Case "B"
- .cellbackcolor = color_biz(2)
- .CellForeColor = color_biz(1)
- Case "C"
- .cellbackcolor = color_comp(2)
- .CellForeColor = color_comp(1)
- Case "D"
- .cellbackcolor = color_ber(2)
- .CellForeColor = color_ber(1)
- Case "E"
- .cellbackcolor = color_mat(2)
- .CellForeColor = color_mat(1)
- Case "H"
- .cellbackcolor = color_holiday(2)
- .CellForeColor = color_holiday(1)
- Case "I"
- .cellbackcolor = color_ind(2)
- .CellForeColor = color_ind(1)
- Case "L"
- .cellbackcolor = color_late(2)
- .CellForeColor = color_late(1)
- Case "M"
- .cellbackcolor = color_matl(2)
- .CellForeColor = color_matl(1)
- Case "N"
- .cellbackcolor = color_msus(2)
- .CellForeColor = color_msus(1)
- Case "P"
- .cellbackcolor = color_pat(2)
- .CellForeColor = color_pat(1)
- Case "S"
- .cellbackcolor = color_sickness(2)
- .CellForeColor = color_sickness(1)
- Case "T"
- .cellbackcolor = color_tra(2)
- .CellForeColor = color_tra(1)
- Case "U"
- .cellbackcolor = color_una(2)
- .CellForeColor = color_una(1)
- Case "W"
- .cellbackcolor = color_work(2)
- .CellForeColor = color_work(1)
- Case "X"
- .cellbackcolor = color_unex(2)
- .CellForeColor = color_unex(1)
- End Select
- If Len(ForeColorList(daycol)) > 0 Then
- .cellbackcolor = BackColorList(daycol)
- .CellForeColor = ForeColorList(daycol)
- End If
- If holidays(daycol) Then
- .cellbackcolor = 2635756
- End If
- Next daycol
- rs.MoveNext
- Wend
- rs.Close
- End With
- cnn.Close
- Progress_Msg "", True
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement