工资结算.frm

企业工资管理系统的主要任务是用计算机对各种工资信息进行日常的管理

         Height          =   375
         Left            =   960
         TabIndex        =   2
         Top             =   960
         Width           =   1095
      End
      Begin VB.TextBox txtName 
         Height          =   375
         Left            =   960
         TabIndex        =   1
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "职称："
         Height          =   180
         Left            =   2520
         TabIndex        =   10
         Top             =   1080
         Width           =   540
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "职务："
         Height          =   180
         Left            =   2520
         TabIndex        =   9
         Top             =   480
         Width           =   540
      End
      Begin VB.Label l3 
         AutoSize        =   -1  'True
         Caption         =   "部门："
         Height          =   180
         Left            =   120
         TabIndex        =   8
         Top             =   1800
         Width           =   540
      End
      Begin VB.Label l2 
         AutoSize        =   -1  'True
         Caption         =   "编号："
         Height          =   180
         Left            =   120
         TabIndex        =   7
         Top             =   1080
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "姓名："
         Height          =   180
         Left            =   120
         TabIndex        =   6
         Top             =   480
         Width           =   540
      End
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "实发工资："
      Height          =   180
      Left            =   5760
      TabIndex        =   54
      Top             =   360
      Width           =   900
   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
     'objCn用于建立数据库连接
     'objRsStuff用于保存"员工信息"表数据
     'objRsDutyWage用于保存"职务工资"表数据
     'objRsFoot用于保存"工资结算"表数据
     'objRsElseWage用于保存"其他工资"表数据
     'objRsTitleWage用于保存"职称工资"表数据

Private Sub cmdDeleteAll_Click()     '删除所有结算数据
 On Error GoTo DealError
  If objRsFoot.RecordCount > 0 Then
     n = MsgBox("是否删除所有工资结算数据?", vbQuestion + vbYesNo, "工资结算")
     If n = vbYes Then
        objCn.Execute "Detele From工资结算"
        MsgBox "所有结算数据已被成功删除！", vbInformation, "工资结算"
        objRsFoot.Requery                                           '刷新工资结算数据
     End If
   Else
      MsgBox "没有结算数据！", vbInformation, "工资结算"
   End If
   Show Wage
   Exit Sub

DealError:
   ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

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"Detele From工资结算" Where 编号= " '& objRsStuff.Fields("编号")&" ' "
        MsgBox "当前员工结算数据已被成功删除！", vbInformation, "工资结算"
        objRsFoot.Requery                                           '刷新工资结算数据
     End If
   Else
      MsgBox "没有结算数据！", vbInformation, "工资结算"
   End If
   Show Wage
   Exit Sub

DealError:
   ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description

End Sub

Private Sub cmdExit_Click()
    Set objRs = Nothing
    objCn.Close
    Set objCn = Nothing

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

'定义ShowWage过程
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 "普通"
                
     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 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("姓名") = Val(txtName)
     .Fields("编号") = Val(txtNum)
     .Fields("部门") = Val(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 Form_Unload(Cancel As Integer)
    objCn.Close
    Set objCn = Nothing
    Set objRsDutyWage = Nothing
    Set objRsFoot = Nothing
    Set objRsElseWage = Nothing
    Set objRsTitleWage = Nothing

End Sub