frmpay1.frm

此程序是用VB编写的企业人事信息管理系统,适合企业人事管理.代码齐全.模块化.操作简单.使用性强.

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