1333 lines
40 KiB
Plaintext
1333 lines
40 KiB
Plaintext
VERSION 5.00
|
|
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "crystl32.ocx"
|
|
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
|
|
Begin VB.Form frmPayList
|
|
Caption = "Payroll List"
|
|
ClientHeight = 7995
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 9030
|
|
ControlBox = 0 'False
|
|
KeyPreview = -1 'True
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
ScaleHeight = 7995
|
|
ScaleWidth = 9030
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.CommandButton cmdPrDetail
|
|
Caption = "Print Pay Detail"
|
|
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 = 2400
|
|
TabIndex = 23
|
|
Top = 7380
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdUpEmpMaster
|
|
Caption = "Up Emp Master"
|
|
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 = 1260
|
|
TabIndex = 22
|
|
Top = 7380
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdMoveMAS90
|
|
Caption = "Move PR to MAS90"
|
|
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 = 3540
|
|
TabIndex = 21
|
|
Top = 7380
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPRProcess
|
|
Caption = "Setup PR for MAS90"
|
|
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 = 120
|
|
TabIndex = 20
|
|
Top = 7380
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmd1TimeSheet
|
|
Caption = "1 Time Sheet"
|
|
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 = 2400
|
|
TabIndex = 19
|
|
TabStop = 0 'False
|
|
Top = 6720
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrintPayLog
|
|
Caption = "Payroll Log"
|
|
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 = 1260
|
|
TabIndex = 18
|
|
TabStop = 0 'False
|
|
Top = 6720
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrint1Crew
|
|
Caption = "1 Crew Summary"
|
|
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 = 3540
|
|
TabIndex = 17
|
|
TabStop = 0 'False
|
|
Top = 6720
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrint1
|
|
Caption = "1 VWP Summary"
|
|
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 = 120
|
|
TabIndex = 16
|
|
TabStop = 0 'False
|
|
Top = 6720
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrintTimeSheets
|
|
Caption = "Time Sheets"
|
|
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 = 2400
|
|
TabIndex = 15
|
|
TabStop = 0 'False
|
|
Top = 6060
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrintData
|
|
Caption = "Data Input Sheet"
|
|
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 = 1260
|
|
TabIndex = 14
|
|
TabStop = 0 'False
|
|
Top = 6060
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdPrintCrew
|
|
Caption = "Print Crew Summary"
|
|
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 = 3540
|
|
TabIndex = 13
|
|
TabStop = 0 'False
|
|
Top = 6060
|
|
Width = 1035
|
|
End
|
|
Begin Crystal.CrystalReport crPay
|
|
Left = 6900
|
|
Top = 5520
|
|
_ExtentX = 741
|
|
_ExtentY = 741
|
|
_Version = 348160
|
|
WindowState = 2
|
|
PrintFileLinesPerPage= 60
|
|
End
|
|
Begin VB.CommandButton cmdPrint
|
|
Caption = "Print VWP Summary"
|
|
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 = 120
|
|
TabIndex = 12
|
|
TabStop = 0 'False
|
|
Top = 6060
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdAddMember
|
|
Caption = "Add &Members"
|
|
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 = 1260
|
|
TabIndex = 5
|
|
TabStop = 0 'False
|
|
Top = 5400
|
|
Width = 1035
|
|
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 = 2400
|
|
TabIndex = 6
|
|
TabStop = 0 'False
|
|
Top = 5400
|
|
Width = 1035
|
|
End
|
|
Begin VB.TextBox txtCrewID
|
|
Height = 375
|
|
Left = 5160
|
|
TabIndex = 11
|
|
TabStop = 0 'False
|
|
Top = 5580
|
|
Visible = 0 'False
|
|
Width = 1215
|
|
End
|
|
Begin VB.ListBox lstCrew
|
|
Height = 3765
|
|
Left = 4680
|
|
Sorted = -1 'True
|
|
TabIndex = 8
|
|
TabStop = 0 'False
|
|
Top = 1560
|
|
Width = 4215
|
|
End
|
|
Begin VB.CommandButton cmdDelete
|
|
Caption = "&Delete Crew"
|
|
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 = 3540
|
|
TabIndex = 7
|
|
TabStop = 0 'False
|
|
Top = 5400
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdAdd
|
|
Caption = "&Add Crew"
|
|
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 = 120
|
|
TabIndex = 4
|
|
TabStop = 0 'False
|
|
Top = 5400
|
|
Width = 1035
|
|
End
|
|
Begin VB.ListBox lstPayCrews
|
|
Height = 3765
|
|
Left = 120
|
|
TabIndex = 2
|
|
Top = 1560
|
|
Width = 4455
|
|
End
|
|
Begin MSComCtl2.DTPicker dtpPayDate
|
|
Height = 315
|
|
Left = 1320
|
|
TabIndex = 0
|
|
Top = 180
|
|
Width = 1215
|
|
_ExtentX = 2143
|
|
_ExtentY = 556
|
|
_Version = 393216
|
|
Format = 20250625
|
|
CurrentDate = 36942
|
|
MaxDate = 55153
|
|
MinDate = 36892
|
|
End
|
|
Begin VB.Label lblCrewInstruct
|
|
Caption = "Double Click or CTRL S on the desired crew listed below to add the crew to the current payroll 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 = 615
|
|
Left = 5340
|
|
TabIndex = 10
|
|
Top = 660
|
|
Width = 2955
|
|
End
|
|
Begin VB.Label lblInstruct
|
|
Caption = "Double Click or CTRL P on the desired crew to view payroll informaton for that crew for the payroll date shown."
|
|
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 = 180
|
|
TabIndex = 9
|
|
Top = 600
|
|
Width = 4395
|
|
End
|
|
Begin VB.Label lblCrew
|
|
AutoSize = -1 'True
|
|
Caption = "Crews for this payroll:"
|
|
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 = 180
|
|
TabIndex = 3
|
|
Top = 1320
|
|
Width = 1845
|
|
End
|
|
Begin VB.Label lblPRDate
|
|
Alignment = 1 'Right Justify
|
|
AutoSize = -1 'True
|
|
Caption = "Payroll Date:"
|
|
Height = 195
|
|
Left = 360
|
|
TabIndex = 1
|
|
Top = 240
|
|
Width = 900
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmPayList"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
Dim moRSPay As Recordset
|
|
Dim moRSCREW As Recordset
|
|
|
|
Dim mboolAdding As Boolean
|
|
|
|
Private Sub cmd1TimeSheet_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
strSQL = "{tblcrew.crew_id} = " & Left$(lstPayCrews.Text, 3)
|
|
crPAY.ReportFileName = App.Path & "\timesheet.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
crPAY.Destination = crptToPrinter
|
|
crPAY.CopiesToPrinter = 1
|
|
crPAY.Action = 1
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmd1TimeSheet_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdAdd_Click()
|
|
Dim intID As Integer, strSQL As String, lngINDEX As Long, lngFind As Long
|
|
Dim oRS As Recordset
|
|
On Error GoTo Error_EH
|
|
|
|
cmdAdd.Enabled = False
|
|
cmdDelete.Enabled = False
|
|
'Code to Add a Crew
|
|
mboolAdding = True
|
|
intID = InputBox("Enter The Crew Number To Add", "Crew Number", 999)
|
|
If intID > 0 Then
|
|
strSQL = "SELECT Crew_id, Crew_Boss, Type, Inactive FROM tblCREW WHERE crew_id = " & intID
|
|
Set oRS = New Recordset
|
|
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
|
If Not oRS.EOF Then
|
|
If oRS!inactive Then
|
|
MsgBox "This Crew - " & oRS!crew_boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew"
|
|
cmdAdd.Enabled = True
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
If oRS.EOF Then
|
|
Call CrewLoad
|
|
Else
|
|
txtCrewId = oRS!crew_id
|
|
Call FormSave
|
|
cmdAdd.Enabled = True
|
|
If lstPayCrews.ListCount Then
|
|
cmdDelete.Enabled = True
|
|
End If
|
|
|
|
cmdAdd.SetFocus
|
|
End If
|
|
Else
|
|
cmdAdd.Enabled = True
|
|
If lstPayCrews.ListCount Then
|
|
cmdDelete.Enabled = True
|
|
End If
|
|
cmdAdd.SetFocus
|
|
Exit Sub
|
|
End If
|
|
lngFind = Field2Long(intID)
|
|
Call CBFindString2(lstPayCrews, Field2Str(intID))
|
|
' lstPayCrews.SetFocus
|
|
' lngINDEX = ListFindItem(lstPayCrews, lngFind)
|
|
' Call ListFindItem3(lstPayCrews, lngFind)
|
|
' lstPayCrews.ListIndex = lngINDEX
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
If Err.Number = 13 Then
|
|
cmdAdd.Enabled = True
|
|
If lstPayCrews.ListCount Then
|
|
cmdDelete.Enabled = True
|
|
End If
|
|
Resume Next
|
|
End If
|
|
gstrMODULE = "Form PayList - Module FieldsSave"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
Private Sub FieldsSave()
|
|
Dim strSQL As String
|
|
Dim oRS As Recordset
|
|
On Error GoTo Error_EH
|
|
|
|
strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = 1"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
|
|
|
If mboolAdding Then
|
|
oRS.AddNew
|
|
oRS!C_USER = gstrLOGIN
|
|
End If
|
|
|
|
|
|
With oRS
|
|
!U_USER = gstrLOGIN
|
|
!Updated = Date
|
|
!crew_id = txtCrewId
|
|
!Pay_Date = dtpPayDate.Value
|
|
End With
|
|
|
|
oRS.Update
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
If Err.Number = -2147467259 Then
|
|
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
|
|
Resume Next
|
|
End If
|
|
gstrMODULE = "Form PayList - Module FieldsSave"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub FormSave()
|
|
Dim strName As String
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
|
|
' Store the controls to the recordset
|
|
Call FieldsSave
|
|
|
|
' moRSPay.Update
|
|
|
|
If mboolAdding Then
|
|
mboolAdding = False
|
|
|
|
End If
|
|
|
|
Call PayLoad
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
' Call ErrorHandler(moRSPay.ActiveConnection)
|
|
gstrMODULE = "Form PayList - Module FieldsSave"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub PayLoad()
|
|
Dim oRS As Recordset
|
|
Dim strSQL As String, strCREW As String
|
|
Dim strLine As String
|
|
On Error GoTo Error_EH
|
|
|
|
strSQL = "SELECT * from tblPayHeader WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY crew_id"
|
|
|
|
Set moRSCREW = New Recordset
|
|
|
|
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
|
|
|
|
lstPayCrews.Clear
|
|
|
|
Do Until moRSCREW.EOF
|
|
With lstPayCrews
|
|
strCREW = "SELECT * FROM tblCrew where CREW_id = " & moRSCREW!crew_id
|
|
Set oRS = New Recordset
|
|
oRS.Open strCREW, goConn, adOpenKeyset, adLockOptimistic
|
|
If Not oRS.EOF Then
|
|
strLine = Field2Str(moRSCREW!crew_id) & " " & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!crew_boss)
|
|
.AddItem strLine
|
|
.ItemData(.NewIndex) = moRSCREW!pay_id
|
|
End If
|
|
End With
|
|
|
|
moRSCREW.MoveNext
|
|
Loop
|
|
moRSCREW.Close
|
|
|
|
If lstPayCrews.ListCount Then
|
|
lstPayCrews.ListIndex = 0
|
|
cmdAddMember.Enabled = True
|
|
cmdDelete.Enabled = True
|
|
cmdPrint.Enabled = True
|
|
cmdPrintCrew.Enabled = True
|
|
cmdPrintData.Enabled = True
|
|
cmdPrintTimeSheets.Enabled = True
|
|
cmdPrint1.Enabled = True
|
|
cmdPrint1Crew.Enabled = True
|
|
cmdPrintPayLog.Enabled = True
|
|
cmd1TimeSheet.Enabled = True
|
|
cmdPRProcess.Enabled = True
|
|
cmdUpEmpMaster.Enabled = True
|
|
cmdMoveMAS90.Enabled = True
|
|
cmdPrDetail.Enabled = True
|
|
|
|
gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
Else
|
|
cmdAddMember.Enabled = False
|
|
cmdDelete.Enabled = False
|
|
cmdPrint.Enabled = False
|
|
cmdPrintCrew.Enabled = False
|
|
cmdPrintData.Enabled = False
|
|
cmdPrintTimeSheets.Enabled = False
|
|
cmdPrint1.Enabled = False
|
|
cmdPrint1Crew.Enabled = False
|
|
cmdPrintPayLog.Enabled = False
|
|
cmd1TimeSheet.Enabled = False
|
|
cmdPRProcess.Enabled = False
|
|
cmdUpEmpMaster.Enabled = False
|
|
cmdMoveMAS90.Enabled = False
|
|
cmdPrDetail.Enabled = False
|
|
' Call ChangeButton
|
|
End If
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module PayLoad"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdAddMember_Click()
|
|
Dim intINDEX As Integer
|
|
If lstPayCrews.ListIndex <> -1 Then
|
|
intINDEX = lstPayCrews.ListIndex
|
|
gintCREWID = Left$(Field2Str2(lstPayCrews.Text), 3)
|
|
frmCrewList.Show 1
|
|
Call PayLoad
|
|
lstPayCrews.ListIndex = intINDEX
|
|
Else
|
|
MsgBox "You Must Select A Crew", vbOKOnly, "Select Crew"
|
|
Exit Sub
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdDelete_Click()
|
|
Dim strSQL As String, strYN As String
|
|
|
|
strYN = MsgBox("Are You Sure You Want To Delete This Crew?", vbCritical + vbYesNo, "Delete?")
|
|
|
|
If strYN <> vbYes Then
|
|
Exit Sub
|
|
End If
|
|
|
|
strSQL = "DELETE * FROM tblTIME where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
goConn.Execute strSQL
|
|
|
|
strSQL = "DELETE * FROM tblPayCrew where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
goConn.Execute strSQL
|
|
|
|
strSQL = "DELETE * FROM tblPayHeader WHERE pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
goConn.Execute strSQL
|
|
|
|
Call PayLoad
|
|
End Sub
|
|
|
|
Private Sub cmdExit_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub cmdPrintVWP_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
|
|
oRS.MoveFirst
|
|
Do Until oRS.EOF
|
|
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
|
|
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
oRS.MoveNext
|
|
Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrintVWP_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdMoveMAS90_Click()
|
|
MsgBox "Go to MAS90 and Import the Payroll", vbOKOnly, "Goto MAS90"
|
|
End Sub
|
|
|
|
Private Sub cmdPrDetail_Click()
|
|
Dim strDate As String, strSQL As String, intSUP As Integer
|
|
Dim oRS As Recordset, intYN As Integer
|
|
Dim strSELECT As String
|
|
Dim strBegDate As String, strEndDate As String
|
|
Dim intBYear As String, intBMonth As String, intBDay As String
|
|
Dim intEYear As String, intEMonth As String, intEDay As String
|
|
On Error GoTo Error_EH
|
|
|
|
gboolPRINT = True
|
|
intYN = MsgBox("Remember to Update Check Information Before Printing - Are You Ready?", vbYesNo, "Ready to Print")
|
|
If intYN = vbNo Then
|
|
Exit Sub
|
|
End If
|
|
|
|
intYN = MsgBox("Do You Want To Print to the Printer?", vbYesNo, "Window or Printer")
|
|
If gboolPRINT Then
|
|
strDate = dtpPayDate.Value
|
|
intBYear = Mid(strDate, 7, 4)
|
|
intBDay = Format(Mid(strDate, 4, 2), "00")
|
|
intBMonth = Format(Mid(strDate, 1, 2), "00")
|
|
' intEYear = Mid(txtEndDate, 7, 4)
|
|
' intEDay = Format(Mid(txtEndDate, 4, 2), "00")
|
|
' intEMonth = Format(Mid(txtEndDate, 1, 2), "00")
|
|
|
|
crPAY.ReportFileName = App.Path & "\PayDetail.rpt"
|
|
|
|
crPAY.Formulas(3) = "ZZ_Date = Date(" & intBYear & "," & intBMonth & "," & intBDay & ")"
|
|
' crpay.Formulas(4) = "Z_Crew = " & mintCREW
|
|
' crpay.Formulas(5) = "Z_EndDate = Date(" & intEYear & "," & intEMonth & "," & intEDay & ")"
|
|
|
|
If intYN = vbYes Then
|
|
crPAY.Destination = crptToPrinter
|
|
Else
|
|
crPAY.Destination = crptToWindow
|
|
End If
|
|
crPAY.Action = 1
|
|
|
|
gboolPRINT = False
|
|
End If
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrDetail_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
|
|
Exit Sub
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdPrint_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
|
|
oRS.MoveFirst
|
|
Do Until oRS.EOF
|
|
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
|
|
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
oRS.MoveNext
|
|
Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrint_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
|
|
End Sub
|
|
|
|
Private Sub cmdPrint1_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
' Set oRS = New Recordset
|
|
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
|
|
' oRS.MoveFirst
|
|
' Do Until oRS.EOF
|
|
strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
crPAY.ReportFileName = App.Path & "\payinfo.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
' oRS.MoveNext
|
|
' Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrint1_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdPrint1Crew_Click()
|
|
Dim strSQL As String ', strSQL2 As String
|
|
'Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
crPAY.ReportFileName = App.Path & "\payinfo2.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrint1Crew_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdPrintCrew_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
|
|
oRS.MoveFirst
|
|
Do Until oRS.EOF
|
|
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
|
|
crPAY.ReportFileName = App.Path & "\payinfo2.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
oRS.MoveNext
|
|
Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrintCrew_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdPrintData_Click()
|
|
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
|
|
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
intMonth = Month(dtpPayDate.Value)
|
|
intDay = Day(dtpPayDate.Value)
|
|
intYear = Year(dtpPayDate.Value)
|
|
' Do Until oRS.EOF
|
|
strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
|
|
crPAY.ReportFileName = App.Path & "\paylist.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
' oRS.MoveNext
|
|
' Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrintData_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdPrintPayLog_Click()
|
|
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
frmReport.Show 1
|
|
|
|
intMonth = Month(dtpPayDate)
|
|
intDay = Day(dtpPayDate)
|
|
intYear = Year(dtpPayDate)
|
|
' Do Until oRS.EOF
|
|
' strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
|
|
|
|
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
' Set oRS = New Recordset
|
|
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
|
|
' oRS.MoveFirst
|
|
' Do Until oRS.EOF
|
|
strSQL = "{tblpayheader.pay_Date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
|
|
crPAY.ReportFileName = App.Path & "\paylog.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
' crpay.Destination = crptToPrinter
|
|
crPAY.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = gintCOPY
|
|
crPAY.Action = 1
|
|
' oRS.MoveNext
|
|
' Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrint_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
|
|
End Sub
|
|
|
|
Private Sub cmdPrintTimeSheets_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
gintPRINT = 1
|
|
' frmReport.Show 1
|
|
|
|
strSql2 = "SELECT crew_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
|
|
oRS.MoveFirst
|
|
Do Until oRS.EOF
|
|
strSQL = "{tblcrew.crew_id} = " & Field2Str2(oRS!crew_id)
|
|
crPAY.ReportFileName = App.Path & "\timesheet.rpt"
|
|
crPAY.SelectionFormula = strSQL
|
|
' crPay.Destination = crptToWindow
|
|
crPAY.Destination = crptToPrinter
|
|
' crPay.Destination = gintDEST
|
|
crPAY.CopiesToPrinter = 1
|
|
crPAY.Action = 1
|
|
oRS.MoveNext
|
|
Loop
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPrintTimeSheet_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdPRProcess_Click()
|
|
Dim strSQL As String, strSql2 As String, strSELECT As String
|
|
Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset
|
|
Screen.MousePointer = vbHourglass
|
|
On Error GoTo Error_EH
|
|
|
|
strSql2 = "DELETE * FROM tblPayroll"
|
|
goConn.Execute strSql2
|
|
|
|
|
|
strSQL = "SELECT * FROM tblPayHeader where Pay_Date = #" & dtpPayDate.Value & "# and p_flag"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
|
|
|
strSql2 = "SELECT * FROM tblPayroll"
|
|
Set oRSS = New Recordset
|
|
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
|
|
|
|
Do Until oRS.EOF
|
|
strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id)
|
|
Set oRT = New Recordset
|
|
oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
|
|
Do Until oRT.EOF
|
|
With oRT
|
|
oRSS.AddNew
|
|
oRSS!employee_no = Field2Str(!emp_id)
|
|
oRSS!HOURS_WAGES = Field2Str(!hours)
|
|
oRSS!amount = Field2Str(!gross)
|
|
oRSS!Rate = Field2Str(!Rate)
|
|
oRSS!wc_code = Field2Str(!wc_code)
|
|
oRSS!earncode = "01"
|
|
If Field2Str(!autodeduct) = "" Then
|
|
oRSS!auto_deduction = "N"
|
|
Else
|
|
oRSS!auto_deduction = Field2Str(!autodeduct)
|
|
End If
|
|
oRSS.Update
|
|
End With
|
|
oRT.MoveNext
|
|
Loop
|
|
oRS!P_FLAG = vbUnchecked
|
|
oRS.Update
|
|
oRS.MoveNext
|
|
Loop
|
|
|
|
|
|
Screen.MousePointer = vbDefault
|
|
MsgBox "Payroll Is Ready To Be Imported Into MAS90"
|
|
cmdExit.SetFocus
|
|
Exit Sub
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Screen.MousePointer = vbDefault
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub cmdUpEmpMaster_Click()
|
|
Dim strSQL As String, strSql2 As String
|
|
Dim oRS As Recordset, oRSS As Recordset
|
|
Screen.MousePointer = vbHourglass
|
|
On Error GoTo Error_EH
|
|
|
|
If gboolMAS90 Then
|
|
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
|
|
Exit Sub
|
|
End If
|
|
|
|
strSql2 = "DELETE * FROM PR1_EmployeeMaster"
|
|
goConn.Execute strSql2
|
|
|
|
strSql2 = "SELECT department, employeenumber, lastname, firstname, socialsecuritynumber, DefaultWCCode, employeestatus_AIT FROM PR1_EmployeeMaster"
|
|
Set oRSS = New Recordset
|
|
oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
|
|
|
|
Do Until oRSS.EOF
|
|
strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE employeenumber = '" & Field2Str(oRSS!employeenumber) & "' and department = '" & Field2Str(oRSS!department) & "'"
|
|
Set oRS = New Recordset
|
|
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
|
|
|
|
If oRS.EOF Then
|
|
oRS.AddNew
|
|
oRS!department = Field2Str(oRSS!department)
|
|
oRS!employeenumber = Field2Str(oRSS!employeenumber)
|
|
oRS!lastname = Field2Str(Trim$(oRSS!lastname))
|
|
oRS!firstname = Field2Str(Trim$(oRSS!firstname))
|
|
oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber)
|
|
If Field2Str(oRSS!defaultwccode) = "" Then
|
|
If oRS!department = "53" Then
|
|
oRS!wc_code = "0005022"
|
|
ElseIf oRS!department = "52" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "54" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "55" Then
|
|
oRS!wc_code = "0005606"
|
|
ElseIf oRS!department = "50" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "62" Then
|
|
oRS!wc_code = "0008810"
|
|
ElseIf oRS!department = "61" Then
|
|
oRS!wc_code = "0008810"
|
|
End If
|
|
Else
|
|
oRS!wc_code = Field2Str(oRSS!defaultwccode)
|
|
End If
|
|
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
|
|
oRS.Update
|
|
ElseIf Field2Str(oRSS!department) <> Field2Str(oRS!department) Then
|
|
oRS.Delete
|
|
oRS.AddNew
|
|
oRS!department = Field2Str(oRSS!department)
|
|
oRS!employeenumber = Field2Str(oRSS!employeenumber)
|
|
oRS!lastname = Field2Str(Trim$(oRSS!lastname))
|
|
oRS!firstname = Field2Str(Trim$(oRSS!firstname))
|
|
oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber)
|
|
If Field2Str(oRSS!defaultwccode) = "" Then
|
|
If oRS!department = "53" Then
|
|
oRS!wc_code = "0005022"
|
|
ElseIf oRS!department = "52" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "54" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "55" Then
|
|
oRS!wc_code = "0005606"
|
|
ElseIf oRS!department = "50" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "62" Then
|
|
oRS!wc_code = "0008810"
|
|
ElseIf oRS!department = "61" Then
|
|
oRS!wc_code = "0008810"
|
|
End If
|
|
Else
|
|
oRS!wc_code = Field2Str(oRSS!defaultwccode)
|
|
End If
|
|
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
|
|
oRS.Update
|
|
' End If
|
|
Else
|
|
If Field2Str(oRSS!defaultwccode) = "" Then
|
|
If oRS!department = "53" Then
|
|
oRS!wc_code = "0005022"
|
|
ElseIf oRS!department = "52" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "54" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "55" Then
|
|
oRS!wc_code = "0005606"
|
|
ElseIf oRS!department = "50" Then
|
|
oRS!wc_code = "0005443"
|
|
ElseIf oRS!department = "62" Then
|
|
oRS!wc_code = "0008810"
|
|
ElseIf oRS!department = "61" Then
|
|
oRS!wc_code = "0008810"
|
|
End If
|
|
Else
|
|
oRS!wc_code = Field2Str(oRSS!defaultwccode)
|
|
End If
|
|
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
|
|
oRS.Update
|
|
End If
|
|
oRSS.MoveNext
|
|
|
|
Loop
|
|
Screen.MousePointer = vbDefault
|
|
MsgBox "Employee Master Information Has Been Updated"
|
|
cmdExit.SetFocus
|
|
Exit Sub
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Screen.MousePointer = vbDefault
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub dtpPayDate_Change()
|
|
Call PayLoad
|
|
cmdAdd.SetFocus
|
|
End Sub
|
|
|
|
Private Sub Form_Activate()
|
|
Dim intResponse As Integer
|
|
Dim strSQL As String
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
' mboolSETUP = False
|
|
' mboolENTER = False
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - 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 = vbKeyP Then ' Display key combinations.
|
|
If CtrlDown Then
|
|
Call lstPayCrews_DblClick
|
|
' Call PayLoad
|
|
' Call cmdTotal_Click
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
If KeyCode = vbKeyA Then ' Display key combinations.
|
|
If CtrlDown Then
|
|
Call cmdAdd_Click
|
|
' Call CrewLoad
|
|
' Call cmdTotal_Click
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
If KeyCode = vbKeyM Then ' Display key combinations.
|
|
If CtrlDown Then
|
|
Call cmdAddMember_Click
|
|
' Call CrewLoad
|
|
' Call cmdTotal_Click
|
|
' Call lstLots_DblClick
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
If KeyCode = vbKeyS Then ' Display key combinations.
|
|
If CtrlDown Then
|
|
Call lstCrew_DblClick
|
|
' Call CrewLoad
|
|
' Call cmdTotal_Click
|
|
' Call lstLots_DblClick
|
|
End If
|
|
Exit Sub
|
|
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
|
|
frmPayList.Width = 4725
|
|
dtpPayDate.Value = Date
|
|
Call PayLoad
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module Form_Load"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
Private Sub CrewLoad()
|
|
Dim strSQL As String
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
strSQL = "SELECT * FROM tblCrew Order BY Crew_Boss"
|
|
Set moRSCREW = New Recordset
|
|
moRSCREW.Open strSQL, goConn, _
|
|
adOpenForwardOnly, adLockReadOnly
|
|
|
|
lstCrew.Clear
|
|
|
|
Do Until moRSCREW.EOF
|
|
With lstCrew
|
|
.AddItem Field2Str(moRSCREW!crew_boss)
|
|
.ItemData(.NewIndex) = moRSCREW!crew_id
|
|
End With
|
|
moRSCREW.MoveNext
|
|
Loop
|
|
' moRSCrew.Close
|
|
frmPayList.Width = 9150
|
|
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Form PayList - Module ProjLoad"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
Private Sub lstCrew_DblClick()
|
|
txtCrewId = lstCrew.ItemData(lstCrew.ListIndex)
|
|
frmPayList.Width = 4725
|
|
cmdAdd.Enabled = True
|
|
cmdDelete.Enabled = True
|
|
Call FormSave
|
|
End Sub
|
|
|
|
Private Sub lstPayCrews_DblClick()
|
|
gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex)
|
|
gintCREWID = CInt(Left(lstPayCrews.Text, 3))
|
|
Load frmPayHead
|
|
frmPayHead.lblCrewName = Trim$(Mid$(lstPayCrews.Text, InStr(lstPayCrews.Text, vbTab) + 1))
|
|
frmPayHead.txtPayDate = dtpPayDate.Value
|
|
frmPayHead.txtCrewId = gintCREWID
|
|
|
|
frmPayHead.Show 1
|
|
End Sub
|
|
|