monthbln.frm

感觉还可以了 大家看看 指点下 有什么不足的地方,大家多多指教啊

VERSION 5.00
Begin VB.Form MonthBln 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "月底结算"
   ClientHeight    =   2670
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4215
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2670
   ScaleWidth      =   4215
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Height          =   2415
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3975
      Begin VB.ComboBox Combo1 
         Height          =   300
         ItemData        =   "MonthBln.frx":0000
         Left            =   600
         List            =   "MonthBln.frx":0002
         TabIndex        =   5
         Text            =   "Combo1"
         Top             =   1065
         Width           =   1215
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         Left            =   2400
         TabIndex        =   4
         Text            =   "Combo2"
         Top             =   1080
         Width           =   855
      End
      Begin VB.CommandButton Command2 
         Cancel          =   -1  'True
         Caption         =   "取消"
         Height          =   375
         Left            =   2040
         TabIndex        =   2
         Top             =   1680
         Width           =   1575
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确定"
         Default         =   -1  'True
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Top             =   1680
         Width           =   1575
      End
      Begin VB.Label Label3 
         Caption         =   "工资月份设置"
         Height          =   255
         Left            =   600
         TabIndex        =   8
         Top             =   840
         Width           =   1215
      End
      Begin VB.Label Label4 
         Caption         =   "年"
         Height          =   255
         Left            =   2040
         TabIndex        =   7
         Top             =   1110
         Width           =   255
      End
      Begin VB.Label Label5 
         Caption         =   "月"
         Height          =   255
         Left            =   3360
         TabIndex        =   6
         Top             =   1110
         Width           =   255
      End
      Begin VB.Label Label1 
         Caption         =   "确定要进行结算么？结算后员工月底工资登录进数据库，本月考勤记录清空。"
         Height          =   495
         Left            =   360
         TabIndex        =   3
         Top             =   360
         Width           =   3255
      End
   End
End
Attribute VB_Name = "MonthBln"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim work As New ADODB.Recordset     '考勤记录记录集
    Dim i As Integer
    Dim userid As String        '职工ID
    Dim MONEY As Long
    Dim temp As Long
    Dim resultcount As Long     '结果集所含记录条数
    Dim paydate As String       '月份字串
    
    If Combo1.ListIndex = -1 Then       '年月下拉列表必须都选有数据
        MsgBox "年份必须选择！", vbCritical
        Combo1.SetFocus
        Exit Sub
    End If
    If Combo2.ListIndex = -1 Then
        MsgBox "月份必须选择！", vbCritical
        Combo2.SetFocus
        Exit Sub
    End If
    paydate = Combo1.List(Combo1.ListIndex) & "-" & Combo2.List(Combo2.ListIndex)   '组合年月字串
    If DbHandle.DbConnection Then
        sql = "SELECT USER_ID,USER_NAME,PART_NAME,ROLE_NAME,ROLE_MONEY FROM TBL_USER,TBL_ROLE,TBL_PART WHERE USER_PART=PART_ID AND USER_ROLE=ROLE_ID"
        rs.CursorType = adOpenDynamic
        rs.LockType = adLockOptimistic
        rs.Open sql, DbFinance      '选定用户表中所有记录以及关联的角色和部门记录
        resultcount = DbHandle.resultcount(rs)
        Cls         '设置电子表格的列头
        QueryPay2.MSFlexGrid1.Cols = 5
        QueryPay2.MSFlexGrid1.Rows = resultcount + 1
        QueryPay2.MSFlexGrid1.Row = 0
        QueryPay2.MSFlexGrid1.Col = 0
        QueryPay2.MSFlexGrid1.Text = "员工ID号"
        QueryPay2.MSFlexGrid1.Col = 1
        QueryPay2.MSFlexGrid1.Text = "员工姓名"
        QueryPay2.MSFlexGrid1.Col = 2
        QueryPay2.MSFlexGrid1.Text = "所属部门"
        QueryPay2.MSFlexGrid1.Col = 3
        QueryPay2.MSFlexGrid1.Text = "职位名称"
        QueryPay2.MSFlexGrid1.Col = 4
        QueryPay2.MSFlexGrid1.Text = "本月工资"
        
        For i = 0 To 4
            QueryPay2.MSFlexGrid1.ColWidth(i) = QueryPay2.MSFlexGrid1.Width / 5 - 5     '平均分配每个列的宽
        Next i
        For i = 1 To resultcount        '循环将职工信息和基本工资放入电子表格
            userid = rs("USER_ID")
            QueryPay2.MSFlexGrid1.Row = i
            QueryPay2.MSFlexGrid1.Col = 0
            QueryPay2.MSFlexGrid1.Text = userid
            QueryPay2.MSFlexGrid1.Col = 1
            QueryPay2.MSFlexGrid1.Text = rs("USER_NAME")
            QueryPay2.MSFlexGrid1.Col = 2
            QueryPay2.MSFlexGrid1.Text = rs("PART_NAME")
            QueryPay2.MSFlexGrid1.Col = 3
            QueryPay2.MSFlexGrid1.Text = rs("ROLE_NAME")
            MONEY = rs("ROLE_MONEY")
            QueryPay2.MSFlexGrid1.Col = 4
            QueryPay2.MSFlexGrid1.Text = Str(MONEY)
            rs.MoveNext
        Next i
        rs.Close
        Set rs = Nothing
        For i = 1 To resultcount    '通过考勤表计算考勤信息影响的工资
            QueryPay2.MSFlexGrid1.Row = i
            QueryPay2.MSFlexGrid1.Col = 0
            userid = QueryPay2.MSFlexGrid1.Text
            QueryPay2.MSFlexGrid1.Col = 4
            MONEY = Val(QueryPay2.MSFlexGrid1.Text)
            sql = "SELECT WORK_TIME,TYPE_MARK,TYPE_ID FROM TBL_WORK,TBL_TYPE WHERE WORK_TYPE=TYPE_ID AND WORK_ID='" & userid & "'"
            work.CursorType = adOpenDynamic
            work.LockType = adLockOptimistic
            work.Open sql, DbFinance       '选取每一行职工ID的本月考勤信息
            Do While work.EOF = False
                Select Case work("TYPE_ID")     '通过考勤类别计算考勤时间和工资关系
                    Case 1
                        temp = work("WORK_TIME") * 1
                    Case 2
                        temp = work("WORK_TIME") * 2
                    Case 3
                        temp = work("WORK_TIME") * 10
                    Case 4
                        temp = work("WORK_TIME") * 20
                End Select
                If work("TYPE_MARK") Then       '当考勤类别是加班出差等要向基本工资中加工资
                    MONEY = MONEY + temp
                Else
                    MONEY = MONEY - temp        '当考勤类别是迟到早退等要向基本工资中减工资
                End If
                work.MoveNext
            Loop
            QueryPay2.MSFlexGrid1.Text = Str(MONEY)       '重新设置每个人的月工资
            work.Close
            sql = "TBL_PAY"     '打开月工资表,定位到和电子表格当前行的工资信息
            rs.CursorType = adOpenDynamic
            rs.LockType = adLockOptimistic
            rs.Filter = "PAY_USER='" & userid & "' AND PAY_DATE='" & paydate & "'"
            rs.Open sql, DbFinance
            If DbHandle.resultcount(rs) <> 1 Then   '如果不存在工资信息则新添加一条记录当作当月职工月工资
                rs.Close
                sql = "TBL_PAY"
                rs.CursorType = adOpenDynamic
                rs.LockType = adLockOptimistic
                rs.Filter = ""
                rs.Open sql, DbFinance
                rs.AddNew
            End If
            rs("PAY_USER") = userid     '更新月工资
            rs("PAY_DATE") = paydate    '更新发工资年月
            rs("PAY_MONEY") = MONEY     '更新工资数目
            rs.Update
            rs.Close
        Next i
        '清空考勤记录表
        sql = "DELETE FROM TBL_WORK"
        rs.CursorType = adOpenDynamic
        rs.LockType = adLockOptimistic
        rs.Filter = ""
        rs.Open sql, DbFinance
        DbHandle.DbClose
        QueryPay2.Caption = "结算结果"
        QueryPay2.Show 1    '显示所有员工月工资信息
        Unload Me       '返回主窗体
    Else       '打开数据库失败错误退出
        MsgBox "数据库错误！", vbExclamation
        DbHandle.DbClose
        End
    End If

End Sub

Private Sub Command2_Click()
    Unload Me       '返回主窗体
End Sub

Private Sub Form_Load()
    Dim i As Long
    
    Me.Left = (Screen.Width - Me.ScaleWidth) / 2        '窗体居中显示
    Me.Top = (Screen.Height - Me.ScaleHeight) / 2
    For i = 2003 To 2030        '初始化下拉列表属性
        Combo1.AddItem Trim(Str(i))
    Next i
    For i = 1 To 12
        Combo2.AddItem Trim(Str(i))
    Next i
    Combo1.Text = ""
    Combo2.Text = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    DbHandle.DbClose       '窗体关闭时关闭数据库
End Sub