API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Aug 10th, 2019
93
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 8.55 KB | None | 0 0
raw download clone embed print report
  1. Private Sub Updateflxgrd()
  2. 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
  3. 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
  4. Dim BackColorList() As String, ForeColorList() As String
  5.  
  6. Progress_Msg "Processing Absense Data", False
  7.  
  8. atyear = cmbYear
  9. atmonth = cmbMonth
  10. dinmonth = Day(DateSerial(atyear, atmonth + 1, 0))
  11.  
  12. Set cnn = CurrentProject.AccessConnection
  13. rs.Open "SELECT * FROM tab_at_setup_attendance_codes", cnn, adOpenStatic, adLockReadOnly
  14. While Not rs.EOF
  15.     If Not IsNull(rs!forecolor) Then
  16.         Select Case rs!codeid
  17.             Case "A"
  18.                 color_auth(1) = rs!forecolor
  19.                 color_auth(2) = rs!backcolor
  20.             Case "B"
  21.                 color_biz(1) = rs!forecolor
  22.                 color_biz(2) = rs!backcolor
  23.             Case "C"
  24.                 color_comp(1) = rs!forecolor
  25.                 color_comp(2) = rs!backcolor
  26.             Case "D"
  27.                 color_ber(1) = rs!forecolor
  28.                 color_ber(2) = rs!backcolor
  29.             Case "E"
  30.                 color_mat(1) = rs!forecolor
  31.                 color_mat(2) = rs!backcolor
  32.             Case "H"
  33.                 color_holiday(1) = rs!forecolor
  34.                 color_holiday(2) = rs!backcolor
  35.             Case "I"
  36.                 color_ind(1) = rs!forecolor
  37.                 color_ind(2) = rs!backcolor
  38.             Case "L"
  39.                 color_late(1) = rs!forecolor
  40.                 color_late(2) = rs!backcolor
  41.             Case "M"
  42.                 color_matl(1) = rs!forecolor
  43.                 color_matl(2) = rs!backcolor
  44.             Case "N"
  45.                 color_msus(1) = rs!forecolor
  46.                 color_msus(2) = rs!backcolor
  47.             Case "P"
  48.                 color_pat(1) = rs!forecolor
  49.                 color_pat(2) = rs!backcolor
  50.             Case "S"
  51.                 color_sickness(1) = rs!forecolor
  52.                 color_sickness(2) = rs!backcolor
  53.             Case "T"
  54.                 color_tra(1) = rs!forecolor
  55.                 color_tra(2) = rs!backcolor
  56.             Case "U"
  57.                 color_una(1) = rs!forecolor
  58.                 color_una(2) = rs!backcolor
  59.             Case "W"
  60.                 color_work(1) = rs!forecolor
  61.                 color_work(2) = rs!backcolor
  62.             Case "X"
  63.                 color_unex(1) = rs!forecolor
  64.                 color_unex(2) = rs!backcolor
  65.         End Select
  66.     End If
  67. rs.MoveNext
  68. Wend
  69. rs.Close
  70.  
  71. For daycol = 1 To dinmonth
  72.     weekends(daycol) = False
  73.     holidays(daycol) = False
  74.     If Weekday(DateSerial(atyear, atmonth, daycol)) = 1 Or Weekday(DateSerial(atyear, atmonth, daycol)) = 7 Then
  75.         weekends(daycol) = True
  76.     Else
  77.         weekends(daycol) = False
  78.     End If
  79.  
  80. Next daycol
  81. data = DateSerial(atyear, atmonth, dinmonth)
  82. data = CDate(DateSerial(atyear, atmonth, 1))
  83. data = "SELECT DateofHoliday FROM tab_at_attendance_holidays WHERE DateofHoliday >= #" & atyear & "/" & atmonth & "/" & 1 & "# And DateofHoliday <= #" & atyear & "/" & atmonth & "/" & dinmonth & "#"
  84. 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
  85. While Not rs.EOF
  86.     holidays(Day(rs!DateofHoliday)) = True
  87.     rs.MoveNext
  88. Wend
  89. rs.Close
  90.  
  91. cols = 1 + 31
  92. With Me.grdAttendenceSummary
  93.     .Clear
  94.     .cols = cols
  95.     .rows = 2
  96.     .FixedRows = 1
  97.     .FixedCols = 0
  98.     .ColWidth(0) = 155
  99.     .RowHeight(0) = 300
  100.     .FocusRect = flexFocusHeavy
  101.     .SelectionMode = flexSelectionByRow
  102.    
  103.     .row = 0
  104.     col_ix = 0
  105.     .TextArray(col_ix) = ""
  106.     .ColWidth(col_ix) = 2500
  107.     .ColAlignment(col_ix) = flexAlignLeftCenter
  108.    
  109.     For titcols = 0 To dinmonth - 1
  110.     col_ix = 1 + titcols
  111.     .TextArray(col_ix) = str(1 + titcols)
  112.     .ColWidth(col_ix) = 340
  113.      .ColAlignment(col_ix) = flexAligncentercenter
  114.     Next titcols
  115.    
  116.     For titcols = dinmonth - 1 To 30
  117.     col_ix = 1 + titcols
  118.     .ColWidth(col_ix) = 300
  119.     Next titcols
  120.      
  121.     .RowHeight(1) = 0
  122.  
  123.     If Defined(cmbDepartment) And Not cmbDepartment = -1 Then
  124.         Where = "WHERE deptid = " & cmbDepartment
  125.     End If
  126.    
  127.     Where = Where & IIf(Defined(Where), " AND ", "WHERE ") & " tr_terminated != '1'"
  128.    
  129.     If Defined(cmdLocation) And Not cmdLocation = -1 Then
  130.         Where = Where & IIf(Defined(Where), " AND ", "WHERE ") & "locationid = " & cmdLocation
  131.     End If
  132.  
  133.     Dim sql As String
  134.    
  135.     sql = "SELECT * FROM tab_ps_personnel_details " & Where & " ORDER BY surname"
  136.      rs.Open sql, cnn, adOpenStatic, adLockReadOnly
  137.    
  138.      While Not rs.EOF
  139.  
  140.      For daycol = 1 To dinmonth
  141.      Absense(daycol) = ""
  142.      Next daycol
  143.      
  144.      
  145.      
  146.     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)"
  147.     hw.Open sql, cnn, adOpenStatic, adLockReadOnly
  148.    
  149.     ReDim ForeColorList(31) As String
  150.     ReDim BackColorList(31) As String
  151.    
  152.     While Not hw.EOF
  153.        Absense(Day(hw!cal_date)) = hw!translation_code
  154.        ForeColorList(Day(hw!cal_date)) = hw!forecolor
  155.        BackColorList(Day(hw!cal_date)) = hw!backcolor
  156.        
  157.         hw.MoveNext
  158.     Wend
  159.     hw.Close
  160.  
  161.     abstring = Join(Absense, vbTab)
  162.  
  163.     .AddItem rs!surname & ", " & rs!forename & abstring
  164.      
  165.      
  166.     .row = .rows - 1
  167.     For daycol = 1 To dinmonth
  168.         .col = daycol
  169.        
  170.         If weekends(daycol) Then
  171.         .cellbackcolor = 3068726
  172.         End If
  173.    
  174.         Select Case .Text
  175.             Case "A"
  176.                 .cellbackcolor = color_auth(2)
  177.                 .CellForeColor = color_auth(1)
  178.             Case "B"
  179.                 .cellbackcolor = color_biz(2)
  180.                 .CellForeColor = color_biz(1)
  181.             Case "C"
  182.                 .cellbackcolor = color_comp(2)
  183.                 .CellForeColor = color_comp(1)
  184.             Case "D"
  185.                 .cellbackcolor = color_ber(2)
  186.                 .CellForeColor = color_ber(1)
  187.             Case "E"
  188.                 .cellbackcolor = color_mat(2)
  189.                 .CellForeColor = color_mat(1)
  190.             Case "H"
  191.                 .cellbackcolor = color_holiday(2)
  192.                 .CellForeColor = color_holiday(1)
  193.             Case "I"
  194.                 .cellbackcolor = color_ind(2)
  195.                 .CellForeColor = color_ind(1)
  196.             Case "L"
  197.                 .cellbackcolor = color_late(2)
  198.                 .CellForeColor = color_late(1)
  199.             Case "M"
  200.                 .cellbackcolor = color_matl(2)
  201.                 .CellForeColor = color_matl(1)
  202.             Case "N"
  203.                 .cellbackcolor = color_msus(2)
  204.                 .CellForeColor = color_msus(1)
  205.             Case "P"
  206.                 .cellbackcolor = color_pat(2)
  207.                 .CellForeColor = color_pat(1)
  208.             Case "S"
  209.                 .cellbackcolor = color_sickness(2)
  210.                 .CellForeColor = color_sickness(1)
  211.             Case "T"
  212.                 .cellbackcolor = color_tra(2)
  213.                 .CellForeColor = color_tra(1)
  214.             Case "U"
  215.                 .cellbackcolor = color_una(2)
  216.                 .CellForeColor = color_una(1)
  217.             Case "W"
  218.                 .cellbackcolor = color_work(2)
  219.                 .CellForeColor = color_work(1)
  220.             Case "X"
  221.                 .cellbackcolor = color_unex(2)
  222.                 .CellForeColor = color_unex(1)
  223.         End Select
  224.        
  225.         If Len(ForeColorList(daycol)) > 0 Then
  226.             .cellbackcolor = BackColorList(daycol)
  227.             .CellForeColor = ForeColorList(daycol)
  228.         End If
  229.                
  230.         If holidays(daycol) Then
  231.             .cellbackcolor = 2635756
  232.         End If
  233.        
  234.        
  235.        
  236.     Next daycol
  237.  
  238.     rs.MoveNext
  239.     Wend
  240.     rs.Close
  241.    
  242.    
  243. End With
  244.  
  245. cnn.Close
  246.  
  247. Progress_Msg "", True
  248.  
  249. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!