MonthBln.frm
上传用户:cntx88
上传日期:2022-08-07
资源大小:169k
文件大小:9k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form MonthBln 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "月底结算"
  5.    ClientHeight    =   2670
  6.    ClientLeft      =   45
  7.    ClientTop       =   435
  8.    ClientWidth     =   4215
  9.    LinkTopic       =   "Form1"
  10.    LockControls    =   -1  'True
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2670
  14.    ScaleWidth      =   4215
  15.    StartUpPosition =   3  '窗口缺省
  16.    Begin VB.Frame Frame1 
  17.       Height          =   2415
  18.       Left            =   120
  19.       TabIndex        =   0
  20.       Top             =   120
  21.       Width           =   3975
  22.       Begin VB.ComboBox Combo1 
  23.          Height          =   300
  24.          ItemData        =   "MonthBln.frx":0000
  25.          Left            =   600
  26.          List            =   "MonthBln.frx":0002
  27.          TabIndex        =   5
  28.          Text            =   "Combo1"
  29.          Top             =   1065
  30.          Width           =   1215
  31.       End
  32.       Begin VB.ComboBox Combo2 
  33.          Height          =   300
  34.          Left            =   2400
  35.          TabIndex        =   4
  36.          Text            =   "Combo2"
  37.          Top             =   1080
  38.          Width           =   855
  39.       End
  40.       Begin VB.CommandButton Command2 
  41.          Cancel          =   -1  'True
  42.          Caption         =   "取消"
  43.          Height          =   375
  44.          Left            =   2040
  45.          TabIndex        =   2
  46.          Top             =   1680
  47.          Width           =   1575
  48.       End
  49.       Begin VB.CommandButton Command1 
  50.          Caption         =   "确定"
  51.          Default         =   -1  'True
  52.          Height          =   375
  53.          Left            =   240
  54.          TabIndex        =   1
  55.          Top             =   1680
  56.          Width           =   1575
  57.       End
  58.       Begin VB.Label Label3 
  59.          Caption         =   "工资月份设置"
  60.          Height          =   255
  61.          Left            =   600
  62.          TabIndex        =   8
  63.          Top             =   840
  64.          Width           =   1215
  65.       End
  66.       Begin VB.Label Label4 
  67.          Caption         =   "年"
  68.          Height          =   255
  69.          Left            =   2040
  70.          TabIndex        =   7
  71.          Top             =   1110
  72.          Width           =   255
  73.       End
  74.       Begin VB.Label Label5 
  75.          Caption         =   "月"
  76.          Height          =   255
  77.          Left            =   3360
  78.          TabIndex        =   6
  79.          Top             =   1110
  80.          Width           =   255
  81.       End
  82.       Begin VB.Label Label1 
  83.          Caption         =   "确定要进行结算么?结算后员工月底工资登录进数据库,本月考勤记录清空。"
  84.          Height          =   495
  85.          Left            =   360
  86.          TabIndex        =   3
  87.          Top             =   360
  88.          Width           =   3255
  89.       End
  90.    End
  91. End
  92. Attribute VB_Name = "MonthBln"
  93. Attribute VB_GlobalNameSpace = False
  94. Attribute VB_Creatable = False
  95. Attribute VB_PredeclaredId = True
  96. Attribute VB_Exposed = False
  97. Private Sub Command1_Click()
  98.     Dim sql As String
  99.     Dim rs As New ADODB.Recordset
  100.     Dim work As New ADODB.Recordset     '考勤记录记录集
  101.     Dim i As Integer
  102.     Dim userid As String        '职工ID
  103.     Dim MONEY As Long
  104.     Dim temp As Long
  105.     Dim resultcount As Long     '结果集所含记录条数
  106.     Dim paydate As String       '月份字串
  107.     
  108.     If Combo1.ListIndex = -1 Then       '年月下拉列表必须都选有数据
  109.         MsgBox "年份必须选择!", vbCritical
  110.         Combo1.SetFocus
  111.         Exit Sub
  112.     End If
  113.     If Combo2.ListIndex = -1 Then
  114.         MsgBox "月份必须选择!", vbCritical
  115.         Combo2.SetFocus
  116.         Exit Sub
  117.     End If
  118.     paydate = Combo1.List(Combo1.ListIndex) & "-" & Combo2.List(Combo2.ListIndex)   '组合年月字串
  119.     If DbHandle.DbConnection Then
  120.         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"
  121.         rs.CursorType = adOpenDynamic
  122.         rs.LockType = adLockOptimistic
  123.         rs.Open sql, DbFinance      '选定用户表中所有记录以及关联的角色和部门记录
  124.         resultcount = DbHandle.resultcount(rs)
  125.         Cls         '设置电子表格的列头
  126.         QueryPay2.MSFlexGrid1.Cols = 5
  127.         QueryPay2.MSFlexGrid1.Rows = resultcount + 1
  128.         QueryPay2.MSFlexGrid1.Row = 0
  129.         QueryPay2.MSFlexGrid1.Col = 0
  130.         QueryPay2.MSFlexGrid1.Text = "员工ID号"
  131.         QueryPay2.MSFlexGrid1.Col = 1
  132.         QueryPay2.MSFlexGrid1.Text = "员工姓名"
  133.         QueryPay2.MSFlexGrid1.Col = 2
  134.         QueryPay2.MSFlexGrid1.Text = "所属部门"
  135.         QueryPay2.MSFlexGrid1.Col = 3
  136.         QueryPay2.MSFlexGrid1.Text = "职位名称"
  137.         QueryPay2.MSFlexGrid1.Col = 4
  138.         QueryPay2.MSFlexGrid1.Text = "本月工资"
  139.         
  140.         For i = 0 To 4
  141.             QueryPay2.MSFlexGrid1.ColWidth(i) = QueryPay2.MSFlexGrid1.Width / 5 - 5     '平均分配每个列的宽
  142.         Next i
  143.         For i = 1 To resultcount        '循环将职工信息和基本工资放入电子表格
  144.             userid = rs("USER_ID")
  145.             QueryPay2.MSFlexGrid1.Row = i
  146.             QueryPay2.MSFlexGrid1.Col = 0
  147.             QueryPay2.MSFlexGrid1.Text = userid
  148.             QueryPay2.MSFlexGrid1.Col = 1
  149.             QueryPay2.MSFlexGrid1.Text = rs("USER_NAME")
  150.             QueryPay2.MSFlexGrid1.Col = 2
  151.             QueryPay2.MSFlexGrid1.Text = rs("PART_NAME")
  152.             QueryPay2.MSFlexGrid1.Col = 3
  153.             QueryPay2.MSFlexGrid1.Text = rs("ROLE_NAME")
  154.             MONEY = rs("ROLE_MONEY")
  155.             QueryPay2.MSFlexGrid1.Col = 4
  156.             QueryPay2.MSFlexGrid1.Text = Str(MONEY)
  157.             rs.MoveNext
  158.         Next i
  159.         rs.Close
  160.         Set rs = Nothing
  161.         For i = 1 To resultcount    '通过考勤表计算考勤信息影响的工资
  162.             QueryPay2.MSFlexGrid1.Row = i
  163.             QueryPay2.MSFlexGrid1.Col = 0
  164.             userid = QueryPay2.MSFlexGrid1.Text
  165.             QueryPay2.MSFlexGrid1.Col = 4
  166.             MONEY = Val(QueryPay2.MSFlexGrid1.Text)
  167.             sql = "SELECT WORK_TIME,TYPE_MARK,TYPE_ID FROM TBL_WORK,TBL_TYPE WHERE WORK_TYPE=TYPE_ID AND WORK_ID='" & userid & "'"
  168.             work.CursorType = adOpenDynamic
  169.             work.LockType = adLockOptimistic
  170.             work.Open sql, DbFinance       '选取每一行职工ID的本月考勤信息
  171.             Do While work.EOF = False
  172.                 Select Case work("TYPE_ID")     '通过考勤类别计算考勤时间和工资关系
  173.                     Case 1
  174.                         temp = work("WORK_TIME") * 1
  175.                     Case 2
  176.                         temp = work("WORK_TIME") * 2
  177.                     Case 3
  178.                         temp = work("WORK_TIME") * 10
  179.                     Case 4
  180.                         temp = work("WORK_TIME") * 20
  181.                 End Select
  182.                 If work("TYPE_MARK") Then       '当考勤类别是加班出差等要向基本工资中加工资
  183.                     MONEY = MONEY + temp
  184.                 Else
  185.                     MONEY = MONEY - temp        '当考勤类别是迟到早退等要向基本工资中减工资
  186.                 End If
  187.                 work.MoveNext
  188.             Loop
  189.             QueryPay2.MSFlexGrid1.Text = Str(MONEY)       '重新设置每个人的月工资
  190.             work.Close
  191.             sql = "TBL_PAY"     '打开月工资表,定位到和电子表格当前行的工资信息
  192.             rs.CursorType = adOpenDynamic
  193.             rs.LockType = adLockOptimistic
  194.             rs.Filter = "PAY_USER='" & userid & "' AND PAY_DATE='" & paydate & "'"
  195.             rs.Open sql, DbFinance
  196.             If DbHandle.resultcount(rs) <> 1 Then   '如果不存在工资信息则新添加一条记录当作当月职工月工资
  197.                 rs.Close
  198.                 sql = "TBL_PAY"
  199.                 rs.CursorType = adOpenDynamic
  200.                 rs.LockType = adLockOptimistic
  201.                 rs.Filter = ""
  202.                 rs.Open sql, DbFinance
  203.                 rs.AddNew
  204.             End If
  205.             rs("PAY_USER") = userid     '更新月工资
  206.             rs("PAY_DATE") = paydate    '更新发工资年月
  207.             rs("PAY_MONEY") = MONEY     '更新工资数目
  208.             rs.Update
  209.             rs.Close
  210.         Next i
  211.         '清空考勤记录表
  212.         sql = "DELETE FROM TBL_WORK"
  213.         rs.CursorType = adOpenDynamic
  214.         rs.LockType = adLockOptimistic
  215.         rs.Filter = ""
  216.         rs.Open sql, DbFinance
  217.         DbHandle.DbClose
  218.         QueryPay2.Caption = "结算结果"
  219.         QueryPay2.Show 1    '显示所有员工月工资信息
  220.         Unload Me       '返回主窗体
  221.     Else       '打开数据库失败错误退出
  222.         MsgBox "数据库错误!", vbExclamation
  223.         DbHandle.DbClose
  224.         End
  225.     End If
  226. End Sub
  227. Private Sub Command2_Click()
  228.     Unload Me       '返回主窗体
  229. End Sub
  230. Private Sub Form_Load()
  231.     Dim i As Long
  232.     
  233.     Me.Left = (Screen.Width - Me.ScaleWidth) / 2        '窗体居中显示
  234.     Me.Top = (Screen.Height - Me.ScaleHeight) / 2
  235.     For i = 2003 To 2030        '初始化下拉列表属性
  236.         Combo1.AddItem Trim(Str(i))
  237.     Next i
  238.     For i = 1 To 12
  239.         Combo2.AddItem Trim(Str(i))
  240.     Next i
  241.     Combo1.Text = ""
  242.     Combo2.Text = ""
  243. End Sub
  244. Private Sub Form_Unload(Cancel As Integer)
  245.     On Error Resume Next
  246.     DbHandle.DbClose       '窗体关闭时关闭数据库
  247. End Sub