VERSION 5.00 Begin VB.Form frmPayHead2 Caption = "Payroll Summary Information" ClientHeight = 5355 ClientLeft = 60 ClientTop = 345 ClientWidth = 11880 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 5355 ScaleWidth = 11880 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtPaint BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 11025 TabIndex = 60 Top = 420 Width = 690 End Begin VB.CheckBox chkBiWeekly BackColor = &H00C0FFFF& Caption = "BiWeekly PR" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 285 Left = 1935 TabIndex = 58 Top = 840 Visible = 0 'False Width = 1575 End Begin VB.CommandButton cmdDetail Caption = "House Pay Details" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 6840 TabIndex = 57 Top = 1740 Visible = 0 'False Width = 915 End Begin VB.TextBox txtStone BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 9240 TabIndex = 53 TabStop = 0 'False Top = 420 Width = 690 End Begin VB.CommandButton cmdLook Caption = "Look" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 4140 Picture = "frmPayHead2.frx":0000 Style = 1 'Graphical TabIndex = 51 Top = 1740 Visible = 0 'False Width = 915 End Begin VB.CheckBox chkReady Caption = "Ready to Process" Height = 255 Left = 3840 TabIndex = 40 Top = 3720 Width = 1995 End Begin VB.CheckBox chkDeduct Caption = "Deductions" Height = 255 Left = 10680 TabIndex = 37 TabStop = 0 'False Top = 4800 Width = 1155 End Begin VB.CommandButton cmdDivide Caption = "Divide Equally" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 5400 TabIndex = 36 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.CommandButton cmdSavePay Caption = "&Save Emp. Pay" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 5400 TabIndex = 14 Top = 4740 Width = 1155 End Begin VB.CommandButton cmdTotal Caption = "Update &Totals" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 6960 TabIndex = 25 TabStop = 0 'False Top = 4740 Width = 1155 End Begin VB.CommandButton cmdGetCrew Caption = "Get &Crew List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 6960 TabIndex = 24 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.CommandButton cmdExit Caption = "&Exit" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 3840 TabIndex = 23 TabStop = 0 'False Top = 4740 Width = 1155 End Begin VB.CommandButton cmdAddLot Caption = "Add &House/PO" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 3840 TabIndex = 15 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.TextBox txtGross Alignment = 1 'Right Justify BeginProperty DataFormat Type = 1 Format = "0" HaveTrueFalseNull= 0 FirstDayOfWeek = 0 FirstWeekOfYear = 0 LCID = 1033 SubFormatType = 1 EndProperty Height = 315 Left = 9300 MaxLength = 10 TabIndex = 13 Top = 4740 Width = 1275 End Begin VB.TextBox txtHRate Alignment = 1 'Right Justify Height = 315 Left = 9300 MaxLength = 10 TabIndex = 12 Top = 4440 Width = 1275 End Begin VB.TextBox txtHours Alignment = 1 'Right Justify Height = 315 Left = 9300 MaxLength = 10 TabIndex = 11 Top = 4140 Width = 1275 End Begin VB.ListBox lstCrew Height = 2400 Left = 8220 TabIndex = 10 Top = 1200 Width = 3615 End Begin VB.ListBox lstHouses Height = 2400 Left = 60 Sorted = -1 'True TabIndex = 9 Top = 1200 Width = 3615 End Begin VB.TextBox txtPayDate BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 1200 TabIndex = 8 TabStop = 0 'False Top = 60 Width = 1275 End Begin VB.TextBox txtSumCrew Alignment = 1 'Right Justify BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 9600 TabIndex = 2 TabStop = 0 'False Top = 60 Width = 975 End Begin VB.TextBox txtSumHouse Alignment = 1 'Right Justify BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 7500 TabIndex = 1 TabStop = 0 'False Top = 60 Width = 975 End Begin VB.TextBox txtCrewID BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 3180 TabIndex = 0 TabStop = 0 'False Top = 60 Width = 615 End Begin VB.ListBox lstLots Height = 2400 Left = 3780 Sorted = -1 'True TabIndex = 26 TabStop = 0 'False Top = 1200 Visible = 0 'False Width = 4335 End Begin VB.Label lblPaint AutoSize = -1 'True Caption = "Paint SqFt:" Height = 195 Left = 10110 TabIndex = 59 Top = 480 Width = 780 End Begin VB.Label lblFrameCnt BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1740 TabIndex = 56 Top = 5040 Width = 675 End Begin VB.Label lblFrames Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Frames:" Height = 195 Left = 1125 TabIndex = 55 Top = 5040 Width = 555 End Begin VB.Label lblWCCode BorderStyle = 1 'Fixed Single Height = 315 Left = 10635 TabIndex = 54 Top = 4140 Width = 1185 End Begin VB.Label lblStone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Stone SqFt:" Height = 195 Left = 8355 TabIndex = 52 Top = 480 Width = 840 End Begin VB.Label lblMRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Rate:" Height = 195 Left = 6705 TabIndex = 50 Top = 480 Width = 825 End Begin VB.Label lblDMRate BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 7605 TabIndex = 49 Top = 420 Width = 690 End Begin VB.Label lblDRate2 Alignment = 1 'Right Justify BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 5925 TabIndex = 48 Top = 420 Width = 690 End Begin VB.Label lblDRate Alignment = 1 'Right Justify BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 5220 TabIndex = 47 Top = 420 Width = 690 End Begin VB.Label lblRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Rates:" Height = 195 Left = 4320 TabIndex = 46 Top = 480 Width = 780 End Begin VB.Label lblDMetal BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 3180 TabIndex = 45 Top = 420 Width = 1035 End Begin VB.Label lblMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal:" Height = 195 Left = 2670 TabIndex = 44 Top = 480 Width = 435 End Begin VB.Label lblDFin2 BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 1680 TabIndex = 43 Top = 420 Width = 795 End Begin VB.Label lblDYds BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 600 TabIndex = 42 Top = 420 Width = 1035 End Begin VB.Label lblYds Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Yds:" Height = 195 Left = 240 TabIndex = 41 Top = 480 Width = 315 End Begin VB.Label lblSelect Alignment = 2 'Center Caption = "CTRL-S to Select Lot" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 195 Left = 6240 TabIndex = 39 Top = 3720 Visible = 0 'False Width = 1935 End Begin VB.Label lblTerm Caption = "TERMINATED" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Left = 10590 TabIndex = 38 Top = 3615 Visible = 0 'False Width = 1215 End Begin VB.Label lblBalance Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3780 TabIndex = 35 Top = 840 Width = 4335 End Begin VB.Label lblDelete Caption = "CTRL R to Delete Crews CTRL H to Delete Houses" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 4800 TabIndex = 34 Top = 3240 Width = 2295 End Begin VB.Label lblDifference Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 315 Left = 10680 TabIndex = 33 Top = 60 Width = 1155 End Begin VB.Label lblBC BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2700 TabIndex = 32 Top = 3840 Width = 915 End Begin VB.Label lblPayAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Amount:" Height = 195 Left = 780 TabIndex = 31 Top = 4680 Width = 900 End Begin VB.Label lblType BorderStyle = 1 'Fixed Single Height = 315 Left = 960 TabIndex = 30 Top = 3780 Width = 1695 End Begin VB.Label lblCrewType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew Type:" Height = 195 Left = 120 TabIndex = 29 Top = 3840 Width = 810 End Begin VB.Label lblPay BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1740 TabIndex = 28 Top = 4680 Width = 1875 End Begin VB.Label lblAddress BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 0 TabIndex = 27 Top = 4200 Width = 3615 End Begin VB.Label lblGross Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Amount:" Height = 195 Left = 8295 TabIndex = 22 Top = 4860 Width = 900 End Begin VB.Label lblHRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Hourly Rate:" Height = 195 Left = 8310 TabIndex = 21 Top = 4560 Width = 885 End Begin VB.Label lblHours Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "# of Hours:" Height = 195 Left = 8400 TabIndex = 20 Top = 4260 Width = 795 End Begin VB.Label lblEmpName BorderStyle = 1 'Fixed Single Height = 315 Left = 9300 TabIndex = 19 Top = 3780 Width = 2535 End Begin VB.Label lblEmpId BorderStyle = 1 'Fixed Single Height = 315 Left = 8220 TabIndex = 18 Top = 3780 Width = 1035 End Begin VB.Label lblCrewMember AutoSize = -1 'True Caption = "Crew Workers" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 8280 TabIndex = 17 Top = 900 Width = 1200 End Begin VB.Label lblHouse AutoSize = -1 'True Caption = "Houses && POs" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 120 TabIndex = 16 Top = 900 Width = 1215 End Begin VB.Line Line1 BorderWidth = 2 X1 = 0 X2 = 11880 Y1 = 780 Y2 = 780 End Begin VB.Label lblPayDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Payroll Date:" Height = 195 Left = 225 TabIndex = 7 Top = 120 Width = 900 End Begin VB.Label lblCrewName BorderStyle = 1 'Fixed Single Height = 315 Left = 3840 TabIndex = 6 Top = 60 Width = 2595 End Begin VB.Label lblSumCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Workers Sum:" Height = 195 Left = 8520 TabIndex = 5 Top = 120 Width = 1005 End Begin VB.Label lblSumHouse Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Houses Sum:" Height = 195 Left = 6480 TabIndex = 4 Top = 120 Width = 945 End Begin VB.Label lblCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew:" Height = 195 Left = 2700 TabIndex = 3 Top = 120 Width = 405 End End Attribute VB_Name = "frmPayHead2" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim mboolDelete As Boolean Dim moRSPay As Recordset Dim moRSCREW As Recordset Dim moRSHEAD As Recordset Dim mdblHours As Double, mdblRate As Double, mdblGROSS As Double Dim mbytCOUNT As Byte Dim mstrWTYPE As String, mstrWDone As String Private Sub cmdAddLot_Click() Dim strProj As String, strSQL As String, intPROJ As Integer Dim strLine As String Dim oRS As Recordset, oRSS As Recordset strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code") If Len(strProj) > 0 Then strProj = UCase(strProj) strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then MsgBox "No Project Was Found For The Project Code You Entered. Determine The Correct Code And Re-Enter", vbOKOnly, "No Project Found" Exit Sub Else gintPROJID = Field2Long(oRS!proj_id) ' gintPROJID = Field2Integer(oRS!proj_id) strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID Set oRSS = New Recordset oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lstLots.Clear lstLots.Visible = True Do Until oRSS.EOF With lstLots strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address) .AddItem strLine .ItemData(.NewIndex) = oRSS!Lot_id End With oRSS.MoveNext Loop If lstLots.ListCount Then lblSelect.Visible = True lstLots.ListIndex = 0 End If ' cmdAddLot.SetFocus lstLots.SetFocus End If Else MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code" cmdAddLot.SetFocus Exit Sub End If End Sub Private Sub cmdDetail_Click() Call ViewPayInfo End Sub Private Sub cmdDivide_Click() Dim dblPay As Double, intCount As Integer, intZERO As Integer Dim strSQL As String, strMSG As String, strSELECT As String Dim oRS As Recordset On Error GoTo Error_EH If mbytCOUNT = 0 Then strMSG = "There Are No Crew Workers Shown, This Will Cause An Error" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Exit Payroll and Add The Workers For This Crew!" MsgBox strMSG, vbOKOnly, "Enter Crew Members" Exit Sub End If strSELECT = "SELECT COUNT(pay_id) as cntPAY FROM tblPAYCREW WHERE gross = 0 and pay_id = " & gintPAYID Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly intZERO = Field2Integer(oRS!cntpay) ' dblPay = Round((Field2Str2(txtSumHouse) / mbytCOUNT), 2) dblPay = Round((Field2Str2(lblDifference.Caption) / intZERO), 2) intCount = 1 Do Until intCount > mbytCOUNT lstCrew.ListIndex = intCount - 1 strSQL = "SELECT * " strSQL = strSQL & "FROM tblPayCrew " strSQL = strSQL & "WHERE pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If Field2Str2(moRSCREW!gross) = 0 Then If Field2Str2(dblPay) < 120 Then moRSCREW!hours = 10 ElseIf Field2Str2(dblPay) < 240 Then moRSCREW!hours = 20 ElseIf Field2Str2(dblPay) < 360 Then moRSCREW!hours = 40 ElseIf Field2Str2(dblPay) < 480 Then moRSCREW!hours = 60 Else moRSCREW!hours = 80 End If moRSCREW!gross = Field2Str2(dblPay) moRSCREW!Rate = Format((Field2Str2(moRSCREW!gross) / Field2Str2(moRSCREW!hours)), "#0.00#") moRSCREW.Update End If intCount = intCount + 1 Loop Call CrewLoad Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmdDivide_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdGetCrew_Click() Call GetCrew End Sub Private Sub cmdSavePay_Click() Call CrewSave cmdSavePay.Enabled = False Call cmdTotal_Click lstCrew.SetFocus End Sub Private Sub cmdTotal_Click() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strSQL = "SELECT sum(pay_amt) as SumHouse FROM tblTime where pay_id = " & gintPAYID & " and crew = " & gintCREWID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then txtSumHouse = Format(Field2Str2(oRS!SumHouse), "##,###.00") End If strSQL = "SELECT sum(gross) as SumWorker FROM tblpaycrew where pay_id = " & gintPAYID & " and crew_id = " & gintCREWID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then txtSumCrew = Format(Field2Str2(oRS!SumWorker), "##,###.00") End If lblDifference.Caption = Format(Field2Str2(txtSumHouse) - Field2Str2(txtSumCrew), "##,##0.00;(##,##0.00)") If Field2Str2(lblDifference.Caption) < 0 Then lblDifference.ForeColor = &HFF& lblBalance.Caption = "Crew Greater Than Houses" ElseIf Field2Str2(lblDifference.Caption) > 0 Then lblDifference.ForeColor = &H0& lblBalance.Caption = "Houses Greater Than Crew" Else lblDifference.ForeColor = &H0& lblBalance.Caption = "Payroll is Balanced" End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmdTotal_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdLook_Click() Load frmPayroll frmPayroll.chkLook = vbChecked cmdLook.Visible = False cmdDetail.Visible = False frmPayroll.Show 1 End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH mboolDelete = False If chkBiWeekly = True Then chkBiWeekly.Visible = True Else chkBiWeekly.Visible = False End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module Form_Activate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown If Shift = 4 Then Exit Sub End If ShiftDown = (Shift And vbShiftMask) > 0 AltDown = (Shift And vbAltMask) > 0 CtrlDown = (Shift And vbCtrlMask) > 0 If KeyCode = vbKeyH Then ' Display key combinations. If CtrlDown Then Call HouseDelete Call PayLoad Call cmdTotal_Click End If Exit Sub End If If KeyCode = vbKeyR Then ' Display key combinations. If CtrlDown Then Call CrewDelete Call CrewLoad Call cmdTotal_Click End If Exit Sub End If If KeyCode = vbKeyS Then ' Display key combinations. If CtrlDown Then Call lstLots_DblClick End If Exit Sub End If If KeyCode = vbKeyF Then ' Display key combinations. If CtrlDown Then Call ViewPayInfo ' Call HouseDelete ' Call PayLoad ' Call cmdTotal_Click End If Exit Sub End If End Sub Private Sub ViewPayInfo() Load frmPayInput frmPayInput.chkLook = vbChecked cmdLook.Visible = False cmdDetail.Visible = False frmPayInput.Show 1 End Sub Private Sub CrewDelete() Dim strSQL As String strSQL = "DELETE * FROM tblPayCrew where Pc_id = " & lstCrew.ItemData(lstCrew.ListIndex) goConn.Execute strSQL End Sub Private Sub HouseDelete() Dim strSQL As String Call CheckScaf mboolDelete = True Call PaySheetUpdate strSQL = "DELETE * FROM tblTime where idnum = " & lstHouses.ItemData(lstHouses.ListIndex) goConn.Execute strSQL mboolDelete = False End Sub Private Sub PaySheetUpdate() Dim strSQL As String Dim oRS As Recordset strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS!crewid = 0 oRS!paid = vbUnchecked oRS!Amt = 0 oRS!y_rate = 0 oRS!m_Rate = 0 oRS.Update oRS.Close End If End Sub Private Sub CheckScaf() Dim strSQL As String, oRS As Recordset Dim strSQLL As String, oRSS As Recordset strSQL = "SELECT * FROM tblTIME WHERE idnum = " & lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then If oRS!scafid Then strSQLL = "SELECT * FROM tblSCAFFOLD WHERE scaf_id = " & Field2Long(oRS!scafid) Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then oRSS!paid = vbUnchecked oRSS!pdamt = 0 ' oRSS!prcrew = 0 oRSS.Update oRSS.Close End If End If End If If oRS.State = adStateOpen Then oRS.Close End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub Form_Load() On Error GoTo Error_EH Call GetHeader Call PayLoad Call CrewLoad If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then If gboolMAS90 Then MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" Exit Sub End If Call FormShowCrew End If End If Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFindPay() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblTIME " strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex) Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSPay.EOF Then FormFindPay = False Else FormFindPay = True End If Exit Function Error_EH: gstrMODULE = "Form PayHead - Module FormFindPay" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindCrew() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblPayCrew " strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSCREW.EOF Then FormFindCrew = False Else FormFindCrew = True End If Exit Function Error_EH: gstrMODULE = "Form PayHead - Module FormFindCrew" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FormShowPay() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSC As Recordset On Error GoTo Error_EH With moRSPay strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = " & Field2Str(!Lot_id) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then lblAddress.Caption = Field2Str(oRS!address) If !pay_type = "S" Then lblDYds.Caption = Field2Str(oRS!s_yds) lblDMetal.Caption = "" lblDFin2.Caption = Field2Str2(oRS!fin2) ElseIf !pay_type = "L" Then lblDYds.Caption = Field2Str(oRS!l_yds) lblDMetal.Caption = Field2Str2(oRS!METAL) lblDFin2.Caption = "" ElseIf !pay_type = "V" Then txtStone = Field2Str(oRS!ST_SQFT) lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" ElseIf !pay_type = "C" Then ' strSQL2 = "SELECT * FROM tblScaffold WHERE Lot_id = " & Field2Str(!Lot_id) ' Set oRSC = New Recordset ' oRSC.Open strSQL2, goConn, adOpenForwardOnly, adLockReadOnly ' Call GetScaffold ' txtStone = Field2Str(oRSC!st_sqft) ' If oRSC!up Then lblYds = "Frames:" lblDYds.Caption = Field2Str2(oRS!Scaf6) lblDMetal.Caption = "" ' End If lblDFin2.Caption = Field2Str2(oRS!scaf10) lblFrames.Visible = True lblFrameCnt.Visible = True ElseIf !pay_type = "X" Then txtPaint = Field2Str(oRS!PNT_SQFT) lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" Else lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" End If End If If Field2Str(!pay_type) = "S" Then lblType.Caption = "STUCCO" ElseIf Field2Str(!pay_type) = "L" Then lblType.Caption = "LATH" ElseIf Field2Str(!pay_type) = "V" Then lblType.Caption = "V_STONE" ElseIf Field2Str(!pay_type) = "R" Then lblType.Caption = "REPAIR/PO" ElseIf Field2Str(!pay_type) = "C" Then lblType.Caption = "SCAFFOLD" ElseIf Field2Str(!pay_type) = "X" Then lblType.Caption = "PAINT" End If If !bc Then lblBC.Caption = "Back Chg" ElseIf Field2Str(!workdone) = "W" Then lblBC.Caption = "PO Work" ElseIf Field2Str(!workdone) = "F" Then lblBC.Caption = "Fence" ElseIf Field2Str(!workdone) = "U" Then lblBC.Caption = "CMU" Else lblBC.Caption = "" End If lblPay.Caption = Format(Field2Str2(!pay_amt), "##,##0.00;(##,##0.00)") lblDRate.Caption = Field2Str2(!yd_rate) lblDRate2.Caption = Field2Str2(!fin2_Rate) lblDMRate.Caption = Field2Str2(!mtl_Rate) lblFrameCnt = Field2Str2(!frames) End With Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module FormShowPay" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShowCrew() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset On Error GoTo Error_EH With moRSCREW lblEmpId.Caption = Field2Str(!emp_id) lblEmpName.Caption = Field2Str(!empname) lblWCCode = Field2Str(!wc_code) strSql2 = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & Field2Str2(!emp_id) & "'" Set oRSS = New Recordset oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSS!employeestatus_AIT <> "A" Then lblTerm.Visible = True Else lblTerm.Visible = False End If txtHRate = Format(Field2Str2(!Rate), "#0.00#") txtHours = Format(Field2Str2(!hours), "#0.0#") txtGross = Format(Field2Str2(!gross), "##,##0.00") If Field2Str(!autodeduct) = "Y" Then chkDeduct = vbChecked Else chkDeduct = vbUnchecked End If End With Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module FormShowCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetCrew() Dim oRS As Recordset, oRSS As Recordset Dim strSQL As String, strCREW As String On Error GoTo Error_EH strCREW = "SELECT * FROM tblPayCrew WHERE pc_id = 1" Set oRSS = New Recordset oRSS.Open strCREW, goConn, adOpenForwardOnly, adLockOptimistic strSQL = "SELECT * FROM tblCrewList WHERE crew_id = " & Str2Field(txtCrewID) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then MsgBox "No Workers Were Found For The Highlited Crew. Exit and Enter the Workers", vbOKOnly, "Workers Not Dound" Exit Sub End If Do Until oRS.EOF oRSS.AddNew oRSS!pay_id = gintPAYID oRSS!crew_id = Field2Str(oRS!crew_id) oRSS!emp_id = Field2Str(oRS!emp_id) oRSS!empname = Field2Str(oRS!empname) oRSS!Pay_Date = Field2Str(txtPayDate) oRSS!wc_code = Field2Str(oRS!wc_code) oRSS.Update oRS.MoveNext Loop Call CrewLoad Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Crew Member - This Member will not be saved", , "Duplicate Record" Resume Next ' Exit Sub End If gstrMODULE = "Form PayHead - Module GetCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetHeader() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = " & gintPAYID Set moRSHEAD = New Recordset moRSHEAD.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic chkReady = Field2CheckBox(moRSHEAD!P_FLAG) ' chkReady = moRSHEAD!p_flag Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Crew List - This will not be saved", , "Duplicate Record" Exit Sub End If gstrMODULE = "Form PayHead - Module CrewSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewSave() On Error GoTo Error_EH If moRSCREW.State = adStateClosed Then Exit Sub End If With moRSCREW !Rate = Str2Field(txtHRate.Text) !hours = Str2Field(txtHours.Text) !gross = Str2Field(txtGross.Text) If chkDeduct Then !autodeduct = "Y" Else !autodeduct = "N" End If End With moRSCREW.Update Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module CrewSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetWorkType() Dim strSQL As String, oRSW As Recordset strSQL = "SELECT * FROM tblcboWorkType WHERE WTCode = '" & mstrWDone & "'" Set oRSW = New Recordset oRSW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSW.EOF Then mstrWTYPE = Field2Str(oRSW!worktype) End If oRSW.Close End Sub Private Sub PayLoad() Dim oRS As Recordset Dim strSQL As String, strLOT As String Dim strLine As String, strWORK As String On Error GoTo Error_EH strSQL = "SELECT * from tblTime WHERE Pay_id = " & gintPAYID Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstHouses.Clear Do Until moRSPay.EOF With lstHouses mstrWDone = Field2Str(moRSPay!workdone) Call GetWorkType strWORK = mstrWTYPE If moRSPay!bc Then strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "BACK CHARGE" Else strLOT = Field2Str(moRSPay!proj_lot) & vbTab & strWORK End If ' ElseIf Field2Str(moRSPay!workdone) = "W" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PO WORK" ' ElseIf Field2Str(moRSPay!workdone) = "U" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "CMU" ' ElseIf Field2Str(moRSPay!workdone) = "A" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "TYPAR WRAP" ' ElseIf Field2Str(moRSPay!workdone) = "C" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "COMPLETE" ' ElseIf Field2Str(moRSPay!workdone) = "P" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PARTIAL" ' ElseIf Field2Str(moRSPay!workdone) = "F" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "FENCES" ' ElseIf Field2Str(moRSPay!workdone = "Y") Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "UP" ' ElseIf Field2Str(moRSPay!workdone = "Z") Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "DOWN" ' Else ' strLOT = Field2Str(moRSPay!proj_lot) ' End If .AddItem strLOT .ItemData(.NewIndex) = Field2Long(moRSPay!idnum) End With moRSPay.MoveNext Loop ' moRSPay.Close If lstHouses.ListCount Then lstHouses.ListIndex = 0 Else lstHouses.ListIndex = -1 lblType.Caption = "" lblAddress.Caption = "" lblPay.Caption = "" End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module PayLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstCrew.Clear mbytCOUNT = 0 Do Until moRSCREW.EOF With lstCrew strLine = Field2Str(moRSCREW!emp_id) & " " & Field2Str(moRSCREW!empname) .AddItem strLine .ItemData(.NewIndex) = moRSCREW!pc_id End With mbytCOUNT = Field2Str2(mbytCOUNT) + 1 moRSCREW.MoveNext Loop If lstCrew.ListCount Then lstCrew.ListIndex = 0 Else lstCrew.ListIndex = -1 lblEmpId.Caption = "" lblEmpName.Caption = "" lblWCCode = "" End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SavePay() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then oRS!sum_houses = Field2Str2(txtSumHouse) oRS!sum_workers = Field2Str2(txtSumCrew) oRS!P_FLAG = chkReady oRS.Update End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module lstCrew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim intResponse As Integer, strMSG As String On Error GoTo Error_EH Call SavePay If cmdSavePay.Enabled Then strMSG = "Employee Pay Data Has Been Changed" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Save Changes ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption) Select Case intResponse Case vbYes Call CrewSave Case vbNo Case vbCancel Cancel = True Exit Sub End Select End If If Field2Str2(lblDifference.Caption) <> 0 Then strMSG = "The Payroll Is Not Balanced" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Are You Sure You Want To Exit ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNo, "PAYROLL UNBALANCED") Select Case intResponse Case vbYes Case vbNo Cancel = True Exit Sub End Select End If If moRSPay.State = adStateOpen Then moRSPay.Close End If If moRSCREW.State = adStateOpen Then moRSCREW.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next End If End Sub Private Sub lstCrew_Click() On Error GoTo Error_EH If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then If gboolMAS90 Then MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" Exit Sub End If Call FormShowCrew Else lblEmpId.Caption = "" lblEmpName.Caption = "" lblWCCode = "" txtHRate = "" txtHours = "" txtGross = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module lstCrew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstCrew_DblClick() ' frmCrewList.Show 1 ' Call CrewLoad cmdSavePay.Enabled = True End Sub Private Sub lstHouses_Click() On Error GoTo Error_EH If lstHouses.ListIndex <> -1 Then If FormFindPay() Then Call FormShowPay Else lblType.Caption = "" lblAddress.Caption = "" lblPay.Caption = "" lblDYds.Caption = "" lblDFin2.Caption = "" lblDMetal.Caption = "" lblDRate.Caption = "" lblDRate2.Caption = "" lblDMRate.Caption = "" txtStone = "" txtPaint = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module lstHouses_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstHouses_DblClick() cmdDetail.Visible = True cmdLook.Visible = True gintPROJID = moRSPay!proj_id gintLOTID = moRSPay!Lot_id End Sub Private Sub lstLots_DblClick() Dim strPAYID As String strPAYID = gintPAYID gintLOTID = lstLots.ItemData(lstLots.ListIndex) lstLots.Visible = False Load frmPayInput frmPayInput.txtCrewNo = Field2Str(txtCrewID) frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption) frmPayInput.chkAdd = vbChecked frmPayInput.Show 1 lblSelect.Visible = False Call PayLoad Call cmdTotal_Click cmdAddLot.SetFocus End Sub Private Sub txtGross_GotFocus() mdblGROSS = Field2Str2(txtGross) Call FieldSelect(txtGross) End Sub Private Sub txtGross_LostFocus() If Not IsNumeric(txtGross) Then Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtGross = 0 txtGross.SetFocus Exit Sub End If If Field2Str2(txtGross) <> mdblGROSS Then cmdSavePay.Enabled = True End If Call CalcPay Call cmdTotal_Click End Sub Private Sub txtHours_GotFocus() If Field2Str2(txtHours) = 0 Then txtHours = 80 End If mdblHours = Field2Str2(txtHours) Call FieldSelect(txtHours) End Sub Private Sub txtHours_LostFocus() If Not IsNumeric(txtHours) Then Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtHours = 0 txtHours.SetFocus Exit Sub End If If Field2Str2(txtHours) <> mdblHours Then cmdSavePay.Enabled = True End If End Sub Private Sub txtHRate_GotFocus() mdblRate = Field2Str2(txtHRate) Call FieldSelect(txtHRate) End Sub Private Sub txtHRate_LostFocus() If Not IsNumeric(txtHRate) Then Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtHRate = 0 txtHRate.SetFocus Exit Sub End If If Field2Str2(txtHRate) <> mdblRate Then cmdSavePay.Enabled = True End If End Sub Private Sub CalcPay() If Field2Str2(txtGross) > 0 Then If Field2Str2(txtHours = 0) Then txtHours = 80 mdblHours = Field2Str2(txtHours) cmdSavePay.Enabled = True End If If Field2Str2(txtHRate) = 0 Then txtHRate = Format((Field2Str2(txtGross) / Field2Str2(txtHours)), "##.00#") mdblRate = Field2Str2(txtHRate) cmdSavePay.Enabled = True End If If Field2Str2(txtHRate) < 10 Then MsgBox "The Hourly Rate is below $10.00, Change the Hours Worked To Correct This", vbOKOnly, "Hourly Rate Problem" txtHRate = 0 txtHours.SetFocus End If Exit Sub End If If Field2Str2(txtHours) > 0 And Field2Str2(txtHRate) > 0 Then If mdblHours <> Field2Str2(txtHours) Or mdblRate <> Field2Str2(txtHRate) Then txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00") cmdSavePay.Enabled = True End If Exit Sub End If End Sub