frmpayroll_new.frm

英文版Access数据库编程

    strList.ListItems.add , , "UNABLE TO LOAD LIST OF EMPLOYEES."
End If
End Sub

Private Sub getEmployeeInfo(ByVal strEmployeeID As String)
Dim tempSQL As String
Dim tempRS As Recordset
' Gets the salary of the employee
tempSQL = "SELECT Name, Maritial, Children, Salary FROM Employees WHERE EmployeeID='" & strEmployeeID & "';"
On Error GoTo ErrHandler
RSOpen tempRS, tempSQL, dbOpenSnapshot
If Not tempRS.EOF Then
    lblSalary.Caption = Format$(tempRS("Salary"), "#,##0.00")
    lblName.Caption = tempRS("Name")
    lblID.Caption = strEmployeeID
    lblMaritial.Caption = IIf((CBool(tempRS("Maritial")) = True), "Married", "Single")
    lblChild.Caption = tempRS("Children")
End If
'Gets the leaves taken by the employee
Dim thisMonth, thisYear, numAnnual, numSick, numPaid, numUnpaid As Integer
thisMonth = Month(Now())
thisYear = Year(Now())
'Initialise variables
numAnnual = 0
numSick = 0
numPaid = 0
numUnpaid = 0

tempSQL = "SELECT Emp_Leaves.type, (DateDiff('d',Format([beginDate],'dd/mm/yyyy'),Format([endDate],'dd/mm/yyyy'))) AS numDays " & _
"From Emp_Leaves " & _
"WHERE (((Emp_Leaves.date) Like '##/" & Format$(thisMonth, "00") & "/" & Format$(thisYear, "0000") & "') AND ((Emp_Leaves.EmployeeID)='" & strEmployeeID & "'));"
RSOpen tempRS, tempSQL, dbOpenSnapshot
While Not tempRS.EOF
    If tempRS("type") = "ANNUAL" Then
        numAnnual = numAnnual + tempRS("numDays")
    ElseIf tempRS("type") = "SICK" Then
        numSick = numSick + tempRS("numDays")
    ElseIf tempRS("type") = "UNPAID" Then
        numUnpaid = numUnpaid + tempRS("numDays")
    ElseIf tempRS("type") = "PAID" Then
        numPaid = numPaid + tempRS("numDays")
    End If
    tempRS.MoveNext
Wend
txtAnnual.Text = numAnnual
txtSick.Text = numSick

'Calculate estimated hourly rate
txtRate.Text = CSng(lblSalary.Caption) / CByte(getSettings("numDays"))

ErrHandler:
If Err.Number <> 0 Then
    ErrorNotifier Err.Number, Err.description
    txtCalc(0).SetFocus
End If
End Sub

Private Sub savePayroll()
Dim payRS As Recordset
RSOpen payRS, "SELECT * FROM Payroll", dbOpenDynaset
With payRS
    .AddNew
    .Fields("EmployeeID") = lblID.Caption
    If pay1.Value = True Then
        .Fields("paymentMethod") = pay1.Caption
    ElseIf pay2.Value = True Then
        .Fields("paymentMethod") = pay2.Caption
    Else
        .Fields("paymentMethod") = pay3.Caption
        .Fields("chequeNum") = txtCheque.Text
    End If
    .Fields("dateIssued") = Format$(datepk.Value, "dd/mm/yyyy")
    .Fields("hrsWorked") = txtHours.Text
    .Fields("otHours") = txtOTHours.Text
    .Fields("annualLeaves") = txtAnnual.Text
    .Fields("sickLeaves") = txtSick.Text
    .Fields("unpaidLeaves") = txtUnpaid.Text
    .Fields("epfEmployee") = txtEmployee.Text
    .Fields("epfEmployer") = txtEmployer.Text
    .Fields("otAmount") = txtCalc(1).Text
    .Fields("incomeTax") = txtCalc(5).Text
    .Fields("initialSalary") = txtCalc(0).Text
    .Fields("hourlyRate") = txtRate.Text
    .Fields("socsoAmount") = txtCalc(4).Text
    .Fields("salaryAdvance") = txtCalc(7).Text
    .Fields("incentive") = txtCalc(9).Text
    .Update
End With
payRS.Close
Set payRS = Nothing
InfoMsg "The payroll for the selected employee has been successfully created.", "Record saved"

End Sub

Private Sub autoCalc()
Dim init_sal, ot_bonus, epf_work, epf_emp As Single
Dim socso, inc_tax, net_sal, gross_sal As Single
Dim unpaid_amount As Single
Dim hrRate As Single
'Assign values
hrRate = CSng(txtRate.Text)
hour_work = CSng(txtHours.Text)
ot_hour = CSng(txtOTHours.Text)
ann_leave = CSng(txtAnnual.Text)
sick_leave = CSng(txtSick.Text)

unpaid_leave = CSng(txtUnpaid.Text)
init_sal = CSng(lblSalary.Caption)
'formula

epf_work = getSettings("EPFWorkRate")
epf_emp = getSettings("EPFEmpRate")
unpaid_amount = CSng(hrRate * unpaid_leave)
socso = getEmployeeSocso(init_sal)
gross_sal = init_sal - unpaid_amount
inc_tax = estimateTax(gross_sal)
net_sal = gross_sal - (CSng(txtEmployee.Text) + socso + inc_tax)

'show result
txtEmployee.Text = Format$(CInt(epf_work / 100 * init_sal), "#,##0.00")
txtEmployer.Text = Format$(CInt(epf_emp / 100 * init_sal), "#,##0.00")
txtCalc(0).Text = Format$(init_sal, "#,##0.00")
txtCalc(1).Text = Format$(unpaid_amount, "#,##0.00")
txtCalc(2).Text = Format$(gross_sal, "#,##0.00")
txtCalc(3).Text = txtEmployee.Text
txtCalc(4).Text = Format$(socso, "#,##0.00")
txtCalc(5).Text = Format$(inc_tax, "#,##0.00")
txtCalc(6).Text = Format$(net_sal, "#,##0.00")
'txtCalc(7).Text = Format$(, "#,##0.00") 'Salary advance
txtCalc(8).Text = Format$(net_sal - CSng(txtCalc(7).Text), "#,##0.00")
'txtCalc(9).Text = IIf(IsNull(txtCalc(9).Text), "0", txtCalc(9).Text) '+incentives
txtCalc(10).Text = Format$(CSng(txtCalc(8).Text) + CSng(txtCalc(9).Text), "#,##0.00")
End Sub

Private Function getEmployeeSocso(ByVal initialSalary As Single) As Single
Dim socsoRS As Recordset
RSOpen socsoRS, "SELECT employee FROM socso WHERE amount <= " & initialSalary & ";", dbOpenSnapshot
If Not socsoRS.EOF Then
    socsoRS.MoveLast
    getEmployeeSocso = socsoRS("employee")
Else
    getEmployeeSocso = 0
End If
socsoRS.Close
Set socsoRS = Nothing
End Function

Private Function estimateTax(ByVal ChargeableIncome As Single) As Single
'Based on Malaysia Income Tax 2003 system
'ChargeableIncome is referring to monthly income
On Error GoTo ErrHandler
Dim ci As Single
Dim tax As Integer
ci = ChargeableIncome

If ci <= 2500 Then
    tax = 0
ElseIf ci <= 5000 Then
    tax = 1
ElseIf ci <= 20000 Then
    tax = 3
ElseIf ci <= 35000 Then
    tax = 7
ElseIf ci <= 50000 Then
    tax = 13
ElseIf ci <= 70000 Then
    tax = 19
ElseIf ci <= 100000 Then
    tax = 24
ElseIf ci <= 250000 Then
    tax = 27
Else
    tax = 28
End If

estimateTax = ci * tax / 100
ErrHandler:
If Err.Number <> 0 Then
    CriticalMsg "An error has occurred during the calculation for income tax. Please ensure only valid data is entered.", "Critical error"
    estimateTax = 0
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
Set frmPayroll_New = Nothing
End Sub

Private Sub lvEmployees_ItemClick(ByVal Item As MSComctlLib.ListItem)
With Item
    If .Selected Then
        getEmployeeInfo .Text
    End If
End With
End Sub

Private Sub mnu_Close_Click()
Unload Me
End Sub

Private Sub mnu_Print_Click()
frmPayroll_Print.Show vbModal
End Sub

Private Sub mnu_Save_Click()
Call cmdSave_Click
End Sub

Private Sub pay1_Click()
txtCheque.Enabled = False
End Sub

Private Sub pay2_Click()
txtCheque.Enabled = False
End Sub

Private Sub pay3_Click()
txtCheque.Enabled = True
End Sub

Private Sub txtAnnual_GotFocus()
SelText txtAnnual
End Sub

Private Sub txtAnnual_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtCalc_Change(Index As Integer)
If Len(txtCalc(9).Text) > 0 Then
    autoCalc
End If
End Sub

Private Sub txtCalc_GotFocus(Index As Integer)
SelText txtCalc(Index)
End Sub

Private Sub txtCalc_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtCalc_LostFocus(Index As Integer)
txtCalc(Index).Text = Format$(IIf((txtCalc(Index).Text = ""), "0", txtCalc(Index).Text), "#,##0.00")
End Sub

Private Sub txtCheque_GotFocus()
SelText txtCheque
End Sub

Private Sub txtEmployee_Change()
txtCalc(2).Text = txtEmployee.Text
End Sub

Private Sub txtEmployee_GotFocus()
SelText txtEmployee
End Sub

Private Sub txtEmployee_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtEmployee_LostFocus()
txtEmployee.Text = Format$(IIf((txtEmployee.Text = ""), "0", txtEmployee.Text), "#,##0.00")
End Sub

Private Sub txtEmployer_GotFocus()
SelText txtEmployer
End Sub

Private Sub txtEmployer_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtEmployer_LostFocus()
txtEmployer.Text = Format$(IIf((txtEmployer.Text = ""), "0", txtEmployer.Text), "#,##0.00")
End Sub

Private Sub txtHours_GotFocus()
SelText txtHours
End Sub

Private Sub txtHours_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtOTHours_GotFocus()
SelText txtOTHours
End Sub

Private Sub txtOTHours_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtRate_GotFocus()
SelText txtRate
End Sub

Private Sub txtRate_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtSick_GotFocus()
SelText txtSick
End Sub

Private Sub txtSick_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtUnpaid_GotFocus()
SelText txtUnpaid
End Sub

Private Sub txtUnpaid_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub