frmshowwage.frm

工资管理系统

         TabIndex        =   40
         Top             =   315
         Width           =   1125
      End
      Begin VB.TextBox txtHouse 
         Height          =   270
         Left            =   1050
         TabIndex        =   39
         Top             =   690
         Width           =   1125
      End
      Begin VB.TextBox txtExpert 
         Height          =   270
         Left            =   1080
         TabIndex        =   38
         Top             =   315
         Width           =   1125
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         Caption         =   "应发工资合计"
         Height          =   180
         Left            =   240
         TabIndex        =   31
         Top             =   1170
         Width           =   1080
      End
      Begin VB.Label Label11 
         AutoSize        =   -1  'True
         Caption         =   "职称工资"
         Height          =   180
         Left            =   2385
         TabIndex        =   30
         Top             =   735
         Width           =   720
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         Caption         =   "职务工资"
         Height          =   180
         Left            =   2400
         TabIndex        =   29
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         Caption         =   "住房补贴"
         Height          =   180
         Left            =   240
         TabIndex        =   6
         Top             =   735
         Width           =   720
      End
      Begin VB.Label Label14 
         AutoSize        =   -1  'True
         Caption         =   "其他补贴"
         Height          =   180
         Left            =   4560
         TabIndex        =   4
         Top             =   735
         Width           =   720
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         Caption         =   "一次性补发"
         Height          =   180
         Left            =   4410
         TabIndex        =   3
         Top             =   360
         Width           =   900
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "专家津贴"
         Height          =   180
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "关闭"
      Height          =   300
      Left            =   5655
      TabIndex        =   0
      Top             =   1695
      Width           =   1620
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "实发工资"
      Height          =   180
      Left            =   5655
      TabIndex        =   27
      Top             =   105
      Width           =   720
   End
End
Attribute VB_Name = "ShowWage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim objCn As Connection, objRsStuff As Recordset
Dim objRsDutyWage As Recordset, objRsFoot As Recordset
Dim objRsElseWage As Recordset, objRsTitleWage As Recordset

Private Sub cmdDeleteAll_Click()
    On Error GoTo DealError
    If objRsFoot.RecordCount > 0 Then
        n = MsgBox("是否删除所有工资结算数据？", vbQuestion + vbYesNo, "工资结算")
        If n = vbYes Then
            objCn.Execute "Delete From 工资结算"
            MsgBox "所有结算数据已被成功删除！", vbInformation, "工资结算"
            objRsFoot.Requery                                                 '刷新工资结算数据
        End If
    Else
       MsgBox "没有结算数据！", vbInformation, "工资结算"
    End If
    ShowWage                '计算和显示工资数据
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdDeleteThis_Click()
    On Error GoTo DealError
    If objRsFoot.RecordCount > 0 Then
        n = MsgBox("是否删除当前员工的工资结算数据？", vbQuestion + vbYesNo, "工资结算")
        If n = vbYes Then
            objCn.Execute "Delete From 工资结算 where 编号='" & objRsStuff.Fields("编号") & "'"
            MsgBox "当前员工结算数据已被成功删除！", vbInformation, "工资结算"
            objRsFoot.Requery                                               '刷新工资结算数据
        End If
    Else
       MsgBox "没有结算数据！", vbInformation, "工资结算"
    End If
    ShowWage                '计算和显示工资数据
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdExit_Click()
    Unload Me    '关闭窗体
End Sub
Private Sub cmdMove_Click(Index As Integer)
    On Error GoTo DealError
    With objRsStuff
        Select Case Index       '切换当前记录
            Case 0              '使第一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then .MoveFirst
            Case 1              '使上一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then
                    .MovePrevious
                    If .BOF Then .MoveFirst
                End If
            Case 2              '使下一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then
                    .MoveNext
                    If .EOF Then .MoveLast
                End If
            Case 3              '使最后一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then .MoveLast
        End Select
        If .BOF And .EOF Then   '显示当前记录编号和记录总数
            txtNews = "记录：无"
        Else
            '显示有住房和是否为专家数据
            If objRsStuff!有住房 Then
                chkHouse = 1
            Else
                chkHouse = 0
            End If
            If objRsStuff!是专家 Then
                chkExpert = 1
            Else
                chkExpert = 0
            End If
            txtNews = "记录：" & .AbsolutePosition & "/" & .RecordCount
        End If
    End With
    ShowWage                '计算和显示工资数据
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

'保存工资结算数据
Private Sub cmdSave_Click()
    If objRsStuff.RecordCount > 0 Then
        With objRsFoot
        '检查当前员工工资是否已经结算
        If .RecordCount > 0 Then
            .MoveFirst
            .Find "编号='" & objRsStuff.Fields("编号") & "'"
            If .EOF Then
                '工资未结算，添加新的工资结算记录
                .AddNew
            End If
        Else
            '没有工资结算数据，添加新的工资结算记录
            .AddNew
        End If
        '新添加或已存在的工资记录成为当前记录，更新数据
        .Fields("姓名") = txtName
        .Fields("编号") = txtNum
        .Fields("部门") = txtDept
        .Fields("职务工资") = Val(txtDutyWage)
        .Fields("职称工资") = Val(txtTitleWage)
        .Fields("专家津贴") = Val(txtExpert)
        .Fields("房贴") = Val(txtHouse)
        .Fields("一次性补发") = Val(txtOnce)
        .Fields("其他补贴") = Val(txtElse)
        .Fields("应发合计") = Val(txtSGet)
        .Fields("扣公积金") = Val(txtDG)
        .Fields("扣失业险") = Val(txtDS)
        .Fields("扣医疗险") = Val(txtDY)
        .Fields("扣垃圾费") = Val(txtDL)
        .Fields("扣房租") = Val(txtDF)
        .Fields("扣其他") = Val(txtDQ)
        .Fields("应扣合计") = Val(txtDD)
        .Fields("实发工资") = Val(txtGet)
        .Update
        MsgBox "<" & txtName & ">的工资结算数据成功保存！", vbInformation, "工资结算"
        txtNews = "记录：" & objRsStuff.AbsolutePosition & "/" _
        & objRsStuff.RecordCount & "   结算数据已保存"
        End With
    Else
        MsgBox "无工资结算数据可保存！", vbInformation, "工资结算"
    End If
End Sub

Private Sub Form_Load()
     On Error GoTo DealError
    '建立数据库连接
    Set objCn = New Connection
    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & App.Path & "\数据库\工资管理.mdb"
     objCn.ConnectionString = strcn
     objCn.Open
        
    '创建RecordSet对象，获取工资结算数据
    Set objRsFoot = New Recordset
    Set objRsFoot.ActiveConnection = objCn
    objRsFoot.CursorLocation = adUseClient
    objRsFoot.CursorType = adOpenDynamic
    objRsFoot.LockType = adLockOptimistic
    objRsFoot.Open "SELECT * FROM 工资结算"
    
    '创建RecordSet对象，获取职务工资标准数据
    Set objRsDutyWage = New Recordset
    objRsDutyWage.CursorLocation = adUseClient
    Set objRsDutyWage.ActiveConnection = objCn
    objRsDutyWage.Open "SELECT * FROM 职务工资"
    Set objRsDutyWage.ActiveConnection = Nothing
    
    '创建RecordSet对象，获取职称工资标准数据
    Set objRsTitleWage = New Recordset
    objRsTitleWage.CursorLocation = adUseClient
    Set objRsTitleWage.ActiveConnection = objCn
    objRsTitleWage.Open "SELECT * FROM 职称工资"
    
    '创建RecordSet对象，获取其他工资标准数据
    Set objRsElseWage = New Recordset
    objRsElseWage.CursorLocation = adUseClient
    Set objRsElseWage.ActiveConnection = objCn
    objRsElseWage.Open "SELECT * FROM 其他工资"
    
    '创建RecordSet对象，获取员工信息"数据
    Set objRsStuff = New Recordset
    objRsStuff.CursorLocation = adUseClient
    Set objRsStuff.ActiveConnection = objCn
    objRsStuff.Open "SELECT * FROM 员工信息"
    
    '使用数据绑定显示员工基本信息
    Set txtName.DataSource = objRsStuff
    txtName.DataField = "姓名"
    Set txtNum.DataSource = objRsStuff
    txtNum.DataField = "编号"
    Set txtDept.DataSource = objRsStuff
    txtDept.DataField = "部门"
    Set txtDuty.DataSource = objRsStuff
    txtDuty.DataField = "职务"
    Set txtTitle.DataSource = objRsStuff
    txtTitle.DataField = "职称"
    cmdMove(0).Value = True
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub ShowWage()
    '在工资结算数据中查看当前员工工资是否已结算
    With objRsFoot
        If .RecordCount > 0 Then
            .MoveFirst
            .Find "编号='" & objRsStuff.Fields("编号") & "'"
            If Not .EOF Then
                '工资已结算，直接显示
                txtHouse = .Fields("房贴")
                txtDG = .Fields("扣公积金")
                txtDS = .Fields("扣失业险")
                txtDY = .Fields("扣医疗险")
                txtDF = .Fields("扣房租")
                txtDutyWage = .Fields("职务工资")
                txtTitleWage = .Fields("职称工资")
                txtExpert = .Fields("专家津贴")
                txtOnce = .Fields("一次性补发")
                txtElse = .Fields("其他补贴")
                txtDL = .Fields("扣垃圾费")
                txtDQ = .Fields("扣其他")
                txtSGet = .Fields("应发合计")
                txtDD = .Fields("应扣合计")
                txtGet = .Fields("应发合计")
                txtNews = "记录：" & objRsStuff.AbsolutePosition & "/" _
                            & objRsStuff.RecordCount & "   结算数据已保存"
                Exit Sub
            End If
        End If
    End With
            
    '如果未计算工资，则根据职称计算各项工资
    Select Case txtTitle
        Case "高级"
            txtHouse = objRsElseWage.Fields("房贴") * 3
            txtDG = objRsElseWage.Fields("扣公积金") * 3
            txtDS = objRsElseWage.Fields("扣失业险") * 3
            txtDY = objRsElseWage.Fields("扣医疗险") * 3
        Case "副高"
            txtHouse = objRsElseWage.Fields("房贴") * 2.5
            txtDG = objRsElseWage.Fields("扣公积金") * 2.5
            txtDS = objRsElseWage.Fields("扣失业险") * 2.5
            txtDY = objRsElseWage.Fields("扣医疗险") * 2.5
        Case "中级"
            txtHouse = objRsElseWage.Fields("房贴") * 2
            txtDG = objRsElseWage.Fields("扣公积金") * 2
            txtDS = objRsElseWage.Fields("扣失业险") * 2
            txtDY = objRsElseWage.Fields("扣医疗险") * 2
        Case "初级"
            txtHouse = objRsElseWage.Fields("房贴") * 1.5
            txtDG = objRsElseWage.Fields("扣公积金") * 1.5
            txtDS = objRsElseWage.Fields("扣失业险") * 1.5
            txtDY = objRsElseWage.Fields("扣医疗险") * 1.5
        Case "普通"
            txtHouse = objRsElseWage.Fields("房贴")
            txtDG = objRsElseWage.Fields("扣公积金")
            txtDS = objRsElseWage.Fields("扣失业险")
            txtDY = objRsElseWage.Fields("扣医疗险")
    End Select
    If chkHouse.Value = 1 Then
        txtHouse = 0
        txtDF = objRsElseWage.Fields("扣房租")
    Else
        txtDF = 0
    End If

    '根据职称、职务计算职称、职务工资
    If txtDuty = "无" Then
        txtDutyWage = 0
    Else
        txtDutyWage = objRsDutyWage.Fields("" & txtDuty)
    End If
    txtTitleWage = objRsTitleWage.Fields("" & txtTitle)

    '计算专家津贴
    If chkExpert.Value = 1 Then
        txtExpert = objRsElseWage.Fields("专家津贴")
    Else
        txtExpert = 0
    End If
    
    '显示一次性补发、其他补贴、垃圾费、扣其他费用
    txtOnce = objRsElseWage.Fields("一次性补发")
    txtElse = objRsElseWage.Fields("其他补贴")
    txtDL = objRsElseWage.Fields("扣垃圾费")
    txtDQ = objRsElseWage.Fields("扣其他")
    
    '计算应发工资合计
    txtSGet = Val(txtExpert) + Val(txtSingle) + Val(txtHouse) + Val(txtDutyWage) _
            + Val(txtTitleWage) + Val(txtOnce) + Val(txtElse)
    
    '计算应扣工资合计
    txtDD = Val(txtDG) + Val(txtDS) + Val(txtDY) + Val(txtDL) _
            + Val(txtDF) + Val(txtDQ)
    '计算实发工资
    txtGet = Val(txtSGet) - Val(txtDD)
    txtNews = "记录：" & objRsStuff.AbsolutePosition & "/" _
                        & objRsStuff.RecordCount & "   结算数据没有保存"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    objCn.Close
    Set objCn = Nothing
    Set objRsDutyWage = Nothing
    Set objRsFoot = Nothing
    Set objRsElseWage = Nothing
    Set objRsTitleWage = Nothing
End Sub