www.pudn.com > renshixitong.rar > frmPay1.frm
VERSION 5.00
Begin VB.Form frmPay1
BorderStyle = 3 'Fixed Dialog
Caption = "员工工资"
ClientHeight = 5964
ClientLeft = 48
ClientTop = 336
ClientWidth = 5904
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5964
ScaleWidth = 5904
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.Frame Frame3
Caption = "工资总计"
Height = 1095
Left = 240
TabIndex = 34
Top = 4320
Width = 5415
Begin VB.TextBox txtItem
Height = 270
Index = 9
Left = 3720
MaxLength = 8
TabIndex = 13
Top = 360
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 8
Left = 1320
MaxLength = 8
TabIndex = 12
Top = 360
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 13
Left = 3720
MaxLength = 10
TabIndex = 15
Top = 720
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 12
Left = 1320
MaxLength = 8
TabIndex = 14
Top = 720
Width = 1335
End
Begin VB.Label Label2
Caption = "计发时间："
Height = 255
Index = 15
Left = 2760
TabIndex = 38
Top = 720
Width = 1215
End
Begin VB.Label Label2
Caption = "实发工资："
Height = 255
Index = 14
Left = 360
TabIndex = 37
Top = 720
Width = 1215
End
Begin VB.Label Label2
Caption = "所 得 税："
Height = 255
Index = 13
Left = 2760
TabIndex = 36
Top = 360
Width = 975
End
Begin VB.Label Label2
Caption = "税前小计："
Height = 255
Index = 12
Left = 360
TabIndex = 35
Top = 360
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "员工信息"
Height = 855
Left = 240
TabIndex = 21
Top = 240
Width = 5415
Begin VB.ComboBox cboItem
Height = 300
Index = 1
Left = 3480
Style = 2 'Dropdown List
TabIndex = 1
Top = 360
Width = 1695
End
Begin VB.ComboBox cboItem
Height = 300
Index = 0
Left = 960
Style = 2 'Dropdown List
TabIndex = 0
Top = 360
Width = 1695
End
Begin VB.Label Label2
Caption = "姓 名："
Height = 255
Index = 1
Left = 2760
TabIndex = 23
Top = 360
Width = 975
End
Begin VB.Label Label2
Caption = "部 门："
Height = 255
Index = 0
Left = 240
TabIndex = 22
Top = 360
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "基本工资"
Height = 1815
Left = 240
TabIndex = 20
Top = 1200
Width = 5415
Begin VB.TextBox txtItem
Height = 270
Index = 11
Left = 1200
MaxLength = 8
TabIndex = 8
Top = 1440
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 10
Left = 3600
MaxLength = 8
TabIndex = 7
Top = 1080
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 4
Left = 1200
MaxLength = 8
TabIndex = 6
Top = 1080
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 3
Left = 3600
MaxLength = 8
TabIndex = 5
Top = 720
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 2
Left = 1200
MaxLength = 8
TabIndex = 4
Top = 720
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 1
Left = 3600
MaxLength = 8
TabIndex = 3
Top = 360
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 0
Left = 1200
MaxLength = 8
TabIndex = 2
Top = 360
Width = 1335
End
Begin VB.Label Label2
Caption = "房 租："
Height = 255
Index = 8
Left = 480
TabIndex = 30
Top = 1440
Width = 975
End
Begin VB.Label Label2
Caption = "房 贴："
Height = 255
Index = 7
Left = 2760
TabIndex = 29
Top = 1080
Width = 735
End
Begin VB.Label Label2
Caption = "扣考核："
Height = 255
Index = 6
Left = 480
TabIndex = 28
Top = 1080
Width = 975
End
Begin VB.Label Label2
Caption = "加 班："
Height = 255
Index = 5
Left = 2760
TabIndex = 27
Top = 720
Width = 855
End
Begin VB.Label Label2
Caption = "奖 金："
Height = 255
Index = 4
Left = 480
TabIndex = 26
Top = 720
Width = 735
End
Begin VB.Label Label2
Caption = "补 贴："
Height = 255
Index = 3
Left = 2760
TabIndex = 25
Top = 360
Width = 735
End
Begin VB.Label Label2
Caption = "底 薪："
Height = 255
Index = 2
Left = 480
TabIndex = 24
Top = 360
Width = 855
End
End
Begin VB.Frame Frame5
Caption = "代扣项目"
Height = 1095
Left = 240
TabIndex = 19
Top = 3120
Width = 5415
Begin VB.TextBox txtItem
Height = 270
Index = 6
Left = 3720
MaxLength = 8
TabIndex = 10
Top = 360
Width = 1335
End
Begin VB.TextBox txtItem
Height = 270
Index = 5
Left = 1440
MaxLength = 8
TabIndex = 9
Top = 360
Width = 1215
End
Begin VB.TextBox txtItem
Height = 270
Index = 7
Left = 1440
MaxLength = 8
TabIndex = 11
Top = 720
Width = 1215
End
Begin VB.Label Label2
Caption = "住房公积金："
Height = 255
Index = 11
Left = 360
TabIndex = 33
Top = 720
Width = 1215
End
Begin VB.Label Label2
Caption = "医疗保险："
Height = 255
Index = 10
Left = 2760
TabIndex = 32
Top = 360
Width = 975
End
Begin VB.Label Label2
Caption = "养 老 金："
Height = 255
Index = 9
Left = 360
TabIndex = 31
Top = 360
Width = 1215
End
End
Begin VB.TextBox txtId
Height = 270
Left = 840
TabIndex = 18
TabStop = 0 'False
Top = 5520
Visible = 0 'False
Width = 735
End
Begin VB.CommandButton cmdExit
Caption = "返回 (&X)"
Height = 375
Left = 4440
TabIndex = 17
Top = 5520
Width = 1215
End
Begin VB.CommandButton cmdSave
Caption = "保存 (&S)"
Height = 375
Left = 2880
TabIndex = 16
Top = 5520
Width = 1215
End
End
Attribute VB_Name = "frmPay1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Private Sub cboItem_Click(Index As Integer)
Dim MsgText As String
Dim intCount As Integer
Dim mrcc As ADODB.Recordset
Dim mrcctxt As String
If gintMode = 1 Then
'初始化员工名称和ID
If Index = 0 Then
cboItem(1).Clear
txtSQL = "select ygid,ygname from manrecord where ygdept='" & Trim(cboItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
With cboItem(1)
Do While Not mrc.EOF
.AddItem Trim(mrc!ygname)
mrc.MoveNext
Loop
.ListIndex = 0
End With
Else
MsgBox "请先建立员工档案！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
ElseIf Index = 1 Then
mrc.MoveFirst
mrc.Move cboItem(1).ListIndex
txtId = mrc.Fields(0)
mrcctxt = "select kqpay,kqdeduct from checkin where kqid='" & mrc.Fields(0) & "'" & " and kqdate >= '" & Format(DateSerial(Year(Now), Month(Now), 1), "yyyy/mm/dd") & "' and kqdate<='" & Format(Now, "yyyy/mm/dd") & "'"
Set mrcc = ExecuteSQL(mrcctxt, MsgText)
If Not mrcc.EOF Then
txtItem(3) = mrcc.Fields(0)
txtItem(4) = mrcc.Fields(1)
cmdSave.Enabled = True
Else
MsgBox "请先进行该员工考勤！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
mrcc.Close
End If
End If
End Sub
Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub cmdExit_Click()
If mblChange And cmdSave.Enabled Then
If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
'保存
Call cmdSave_Click
End If
End If
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim intCount As Integer
Dim sMeg As String
Dim recTemp As Recordset
Dim MsgText As String
If Trim(txtItem(0) & " ") = "" Then
sMeg = "底薪"
sMeg = sMeg & "不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
txtItem(0).SetFocus
Exit Sub
End If
If Trim(txtItem(13) & " ") <> "" Then
If Not IsDate(txtItem(13)) Then
MsgBox "时间输入格式不正确，应输入如下格式（yyyy-mm-dd）！", vbOKOnly + vbExclamation, "警告"
txtItem(13).SetFocus
Exit Sub
Else
txtItem(13) = Format(txtItem(13), "yyyy-mm-dd")
End If
Else
MsgBox "时间不能为空！", vbOKOnly + vbExclamation, "警告"
txtItem(13).SetFocus
Exit Sub
End If
'添加判断是否有相同的ID记录
If gintMode = 1 Then
txtSQL = "select * from pay where gzid='" & Trim(txtId) & "' and gzdate between '"
txtSQL = txtSQL & Format(Year(Format(txtItem(13), "yyyy-mm-dd")) & "-" & Month(Format(txtItem(13), "yyyy-mm-dd")) & "-01", "yyyy-mm-dd") & "'"
txtSQL = txtSQL & " and '" & Format(DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(Year(Format(txtItem(13), "yyyy-mm-dd"))), CInt(Month(Format(txtItem(13), "yyyy-mm-dd"))), 1))), "yyyy-mm-dd") & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
MsgBox "已经存在该员工在该月的工资记录！", vbOKOnly + vbExclamation, "警告"
txtItem(13).SetFocus
Exit Sub
End If
mrc.Close
End If
'先删除已有记录
txtSQL = "delete from pay where gzid='" & Trim(txtId) & "' and gzdate='" & Format(txtItem(13), "yyyy-mm-dd") & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'再加入新记录
txtSQL = "select * from pay"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(txtId)
mrc.Fields(1) = Trim(cboItem(1))
For intCount = 0 To 12
mrc.Fields(intCount + 2) = Trim(txtItem(intCount))
Next intCount
mrc.Fields(15) = Trim(txtItem(13))
mrc.Update
mrc.Close
If gintMode = 1 Then
MsgBox "计发工资成功！", vbOKOnly + vbExclamation, "警告"
For intCount = 0 To 12
txtItem(intCount) = ""
Next intCount
mblChange = False
cmdSave.Enabled = False
frmPay.txtSQL = "select * from pay"
frmPay.ShowTitle
frmPay.ShowData
frmPay.ZOrder 1
ElseIf gintMode = 2 Then
MsgBox "修改工资成功！", vbOKOnly + vbExclamation, "警告"
Unload Me
frmPay.txtSQL = "select * from pay"
frmPay.ShowTitle
frmPay.ShowData
frmPay.ZOrder 0
End If
End Sub
Private Sub Form_Load()
Dim MsgText As String
Dim intCount As Integer
Dim dateTemp As Date
If gintMode = 1 Then
Me.Caption = Me.Caption & "添加"
'初始化部门名称
txtSQL = "select DISTINCT ygdept from manrecord"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboItem(0).AddItem Trim(mrc!ygdept)
mrc.MoveNext
Loop
cboItem(0).ListIndex = 0
Else
MsgBox "请先进行员工档案登记！", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
mrc.Close
txtItem(13) = Format(Now, "yyyy-mm-dd")
ElseIf gintMode = 2 Then
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
With mrc
cboItem(1).AddItem .Fields(1)
cboItem(1).ListIndex = 0
For intCount = 2 To 15
If Not IsNull(.Fields(intCount)) Then
txtItem(intCount - 2) = .Fields(intCount)
End If
Next intCount
txtId = .Fields(0)
End With
End If
txtSQL = "select ygdept from manrecord where ygid='" & mrc!gzid & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
cboItem(0).AddItem mrc!ygdept
cboItem(0).ListIndex = 0
End If
mrc.Close
Me.Caption = Me.Caption & "修改"
End If
mblChange = False
End Sub
Private Sub txtItem_Change(Index As Integer)
Dim intCount As Integer
'用于计算工资
Dim dblTotal As Double
'有变化设置gblchange
mblChange = True
If (Index >= 0 And Index < 8) Or Index = 10 Or Index = 11 Then
dblTotal = 0
For intCount = 0 To 3
If Trim(txtItem(intCount)) <> "" Then
dblTotal = dblTotal + CDbl(txtItem(intCount))
End If
Next intCount
For intCount = 4 To 7
If Trim(txtItem(intCount)) <> "" Then
dblTotal = dblTotal - CDbl(txtItem(intCount))
End If
Next intCount
If Trim(txtItem(10)) <> "" Then
dblTotal = dblTotal + CDbl(txtItem(10))
End If
If Trim(txtItem(11)) <> "" Then
dblTotal = dblTotal - CDbl(txtItem(11))
End If
txtItem(8) = Format(dblTotal, "#0.00")
End If
If Index = 9 Then '税额变化
If Trim(txtItem(9) & " ") = "" Then
txtItem(12) = Trim(txtItem(8) & " ")
Else
txtItem(12) = Format(CDbl(txtItem(8)) - CDbl(txtItem(9)), "#0.00")
End If
End If
If Index = 8 And Trim(txtItem(8) & " ") <> "" Then '税前小计变化
dblTotal = CDbl(txtItem(8))
'去掉不交税的工资部分
dblTotal = dblTotal - 1200
'计算税额
If dblTotal <= 0 Then
dblTotal = 0
ElseIf dblTotal > 0 And dblTotal <= 500 Then
dblTotal = dblTotal * 0.05
ElseIf dblTotal > 500 And dblTotal <= 2000 Then
dblTotal = dblTotal * 0.1 - 25#
ElseIf dblTotal > 200 And dblTotal <= 5000 Then
dblTotal = dblTotal * 0.15 - 125#
ElseIf dblTotal > 5000 And dblTotal <= 20000 Then
dblTotal = dblTotal * 0.2 - 375#
Else
MsgBox "请手工计算税额！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
txtItem(9) = Format(dblTotal, "#0.00")
End If
Exit Sub
End Sub
Private Sub txtItem_GotFocus(Index As Integer)
txtItem(Index).SelStart = 0
txtItem(Index).SelLength = Len(txtItem(Index))
End Sub
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Function GetNo() As String
GetNo = Format(Now, "yymmddhhmmss")
Randomize
GetNo = GetNo & Int((99 - 10 + 1) * Rnd + 10)
End Function
Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer)
If Index >= 0 And Index <= 12 Then
'MsgBox KeyCode
'对键入字符进行控制
'txtQuantity(Index).Locked = False
'小数点只允许输入一次
If KeyAscii = 190 Then
If InStr(Trim(txtItem(Index)), ".") = 0 Then
If Len(Trim(txtItem(Index))) > 0 Then
txtItem(Index).Locked = False
Else
txtItem(Index).Locked = True
End If
Else
txtItem(Index).Locked = True
End If
Exit Sub
End If
'非数字不能输入
If KeyAscii > 57 Or KeyAscii < 48 Then
txtItem(Index).Locked = True
Else
txtItem(Index).Locked = False
End If
'允许Backspace
If KeyAscii = 8 Then
txtItem(Index).Locked = False
End If
'Delete键
If KeyAscii = 46 Then
txtItem(Index).Locked = False
End If
End If
End Sub