frmcheckmodi.frm

员工信息管理系统

VERSION 5.00
Begin VB.Form frmCheckmodi 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "考勤信息修改"
   ClientHeight    =   6825
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9510
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6825
   ScaleWidth      =   9510
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox txtCheck_ym 
      Alignment       =   1  'Right Justify
      Enabled         =   0   'False
      Height          =   375
      Left            =   6120
      TabIndex        =   28
      Top             =   720
      Width           =   2175
   End
   Begin VB.TextBox txtEmpInfo 
      Alignment       =   1  'Right Justify
      Enabled         =   0   'False
      Height          =   375
      Left            =   1560
      TabIndex        =   27
      Top             =   720
      Width           =   2775
   End
   Begin VB.TextBox txtCD 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   6120
      MaxLength       =   10
      TabIndex        =   9
      Text            =   "0.00"
      Top             =   5160
      Width           =   2175
   End
   Begin VB.TextBox txtOS 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   10
      TabIndex        =   8
      Text            =   "0.00"
      Top             =   5160
      Width           =   2175
   End
   Begin VB.TextBox txtR 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   4
      TabIndex        =   4
      Text            =   "0.0"
      Top             =   4080
      Width           =   2175
   End
   Begin VB.TextBox txtO 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   4
      TabIndex        =   3
      Text            =   "0.0"
      Top             =   3480
      Width           =   2175
   End
   Begin VB.TextBox txtN 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   4
      TabIndex        =   2
      Text            =   "0.0"
      Top             =   2880
      Width           =   2175
   End
   Begin VB.TextBox txtH 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   4
      TabIndex        =   1
      Text            =   "0.0"
      Top             =   2280
      Width           =   2175
   End
   Begin VB.TextBox txtL 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   6120
      MaxLength       =   2
      TabIndex        =   5
      Text            =   "0"
      Top             =   1680
      Width           =   2175
   End
   Begin VB.TextBox txtE 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   6120
      MaxLength       =   2
      TabIndex        =   6
      Text            =   "0"
      Top             =   2280
      Width           =   2175
   End
   Begin VB.TextBox txtW 
      Alignment       =   1  'Right Justify
      Height          =   375
      Left            =   2160
      MaxLength       =   4
      TabIndex        =   0
      Text            =   "0"
      Top             =   1680
      Width           =   2175
   End
   Begin VB.CommandButton cmdReturn 
      Caption         =   "返 回"
      Height          =   375
      Left            =   8040
      TabIndex        =   11
      Top             =   6120
      Width           =   975
   End
   Begin VB.CommandButton cmdmodi 
      Caption         =   "修 改"
      Default         =   -1  'True
      Height          =   375
      Left            =   6480
      TabIndex        =   10
      Top             =   6120
      Width           =   975
   End
   Begin VB.Frame Frame3 
      Caption         =   "调整工资"
      Height          =   855
      Left            =   480
      TabIndex        =   25
      Top             =   4920
      Width           =   8535
      Begin VB.Label Label14 
         Caption         =   "扣　款："
         Height          =   255
         Left            =   4320
         TabIndex        =   12
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label13 
         Caption         =   "加班费："
         Height          =   255
         Left            =   360
         TabIndex        =   26
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "考勤基本信息"
      Height          =   3255
      Left            =   480
      TabIndex        =   16
      Top             =   1440
      Width           =   8535
      Begin VB.TextBox txtDes 
         Height          =   1215
         IMEMode         =   3  'DISABLE
         Left            =   4320
         MaxLength       =   255
         MultiLine       =   -1  'True
         TabIndex        =   7
         Top             =   1800
         Width           =   3495
      End
      Begin VB.Label Label12 
         Caption         =   "备  注："
         Height          =   255
         Left            =   4320
         TabIndex        =   24
         Top             =   1440
         Width           =   855
      End
      Begin VB.Label Label11 
         Caption         =   "早退次数："
         Height          =   255
         Left            =   4320
         TabIndex        =   23
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label10 
         Caption         =   "迟到次数："
         Height          =   255
         Left            =   4320
         TabIndex        =   22
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label9 
         Caption         =   "补休天数："
         Height          =   255
         Left            =   360
         TabIndex        =   21
         Top             =   2760
         Width           =   975
      End
      Begin VB.Label Label8 
         Caption         =   "旷工天数："
         Height          =   255
         Left            =   360
         TabIndex        =   20
         Top             =   1560
         Width           =   975
      End
      Begin VB.Label Label7 
         Caption         =   "加班天数："
         Height          =   255
         Left            =   360
         TabIndex        =   19
         Top             =   2160
         Width           =   975
      End
      Begin VB.Label Label6 
         Caption         =   "请假天数："
         Height          =   255
         Left            =   360
         TabIndex        =   18
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label5 
         Caption         =   "应出勤天数："
         Height          =   255
         Left            =   360
         TabIndex        =   17
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "考勤对象及范围"
      Height          =   855
      Left            =   480
      TabIndex        =   13
      Top             =   360
      Width           =   8535
      Begin VB.Label Label2 
         Caption         =   "考勤年月："
         Height          =   255
         Left            =   4320
         TabIndex        =   15
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "员  工："
         Height          =   180
         Left            =   360
         TabIndex        =   14
         Top             =   480
         Width           =   720
      End
   End
End
Attribute VB_Name = "frmCheckmodi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset
Dim strSql As String
Function Bhbx(strBhb As String) As String
    Dim intA As Integer
    Dim intB As Integer
    If Left(Trim(strBhb), 1) = "." Then
        strBhb = "0" & strBhb
    End If
    
    intA = InStr(Trim(strBhb), ".")
    If Trim(strBhb) = "" Then
        strBhb = "0.00"
    Else
        If intA = 0 Then
            strBhb = Trim(strBhb) & ".00"
        Else
            intB = Len(Trim(strBhb)) - intA
            If intB = 1 Then
                strBhb = Trim(strBhb) & "0"
            Else
                If intB = 0 Then
                    strBhb = Trim(strBhb) & "00"
                Else
                    strBhb = Left(Trim(strBhb), intA + 2)
                End If
            End If
        End If
    End If
    Bhbx = strBhb
End Function
Private Sub txtCD_LostFocus()

    txtOS = Bhbx(txtOS)
End Sub
Private Sub txtOS_LostFocus()
    txtOS = Bhbx(txtOS)
End Sub



Private Sub cmdmodi_Click()
  ''''''''  On Error GoTo ERR_CONN
    If Trim(txtDes.Text) = "" Then
        txtDes.Text = " "
    End If
    
    If Trim(txtW.Text) = "" Then
        MsgBox "应出勤天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtW.Text = ""
        txtW.SetFocus
        Exit Sub
    End If
    
    If Trim(txtH.Text) = "" Then
        MsgBox "请假天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtH.Text = ""
        txtH.SetFocus
        Exit Sub
    End If
    
    If Trim(txtN.Text) = "" Then
        MsgBox "旷工天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtN.Text = ""
        txtN.SetFocus
        Exit Sub
    End If
    
    If Trim(txtO.Text) = "" Then
        MsgBox "加班天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtO.Text = ""
        txtO.SetFocus
        Exit Sub
    End If
    
    If Trim(txtR.Text) = "" Then
        MsgBox "补休天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtR.Text = ""
        txtR.SetFocus
        Exit Sub
    End If
    
    If Trim(txtL.Text) = "" Then
        MsgBox "迟到天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtL.Text = ""
        txtL.SetFocus
        Exit Sub
    End If
    If Trim(txtE.Text) = "" Then
        MsgBox "早退天数不能为空！", vbOKOnly + vbExclamation, "警告"
        txtE.Text = ""
        txtE.SetFocus
        Exit Sub
    End If
    If Trim(txtOS.Text) = "" Then
        MsgBox "加班费不能为空！", vbOKOnly + vbExclamation, "警告"
        txtOS.Text = ""
        txtOS.SetFocus
        Exit Sub
    End If
    If Trim(txtCD.Text) = "" Then
        MsgBox "扣款不能为空！", vbOKOnly + vbExclamation, "警告"
        txtCD.Text = ""
        txtCD.SetFocus
        Exit Sub
    End If
    strSql = "update checkin set w_days='" & Trim(txtW) & "',l_nums='" & Trim(txtL) & "',e_nums='" & Trim(txtE) & "',h_days='" & Trim(txtH) & "',n_days=" & Trim(txtN) & ", o_days =" & Trim(txtO) & ",r_days=" & Trim(txtR) & ",overtime_s=" & Trim(txtOS) & ",d_check='" & Trim(txtCD) & "',check_des='" & txtDes & "' where emp_id=clng('" & tEmp_id & "') and check_ym='" & tCheck_ym & "' "


    dbConn.Execute strSql
    
    MsgBox "员工考勤修改成功！", vbOKOnly + vbInformation, "提示"
    cmdReturn.SetFocus
    'strSql = "select a.emp_id from salary a,checkin b where b.check_ym=a.check_ym and b.emp_id=a.emp_id and ( b.check_ym='" & tCheck_ym & "'and b.emp_id=clng('" & tEmp_id & "'))"
    'rs.Open strSql, dbConn, adOpenForwardOnly, adLockReadOnly
'    If Not rs.EOF Then
      '  MsgBox "为保证数据的一致,员工工资的资料也必须修改", , "提示"
    'rs.Close     ''''''''''''''''''''''''''''
    'Sxjl
    'End If
    Exit Sub
'''''''''''ERR_CONN:
    MsgBox "请检查数据是否有效！", vbOKOnly + vbExclamation, "警告"
    txtW.SetFocus
End Sub

Private Sub cmdReturn_Click()
    Set rs = Nothing
    Unload Me
End Sub





Private Sub Form_Load()
    Dim strA As String
    Dim strB As String
     Me.Icon = LoadPicture(App.Path & "\Graph07.ico")
    strA = Left(tCheck_ym, 4)
    strB = Right(tCheck_ym, 2)
    txtCheck_ym.Text = strA & "年" & strB & "月"
    strSql = "select a.emp_name,c.dept_name,b.w_days,b.l_nums,b.e_nums,b.h_days,b.n_days,b.o_days,b.r_days,b.overtime_s,b.d_check,b.check_des from employee a,checkin b,department c where( b.check_ym='" & tCheck_ym & "'and b.emp_id=clng('" & tEmp_id & "')) and a.emp_id=b.emp_id and c.dept_id=a.dept_id"
    rs.Open strSql, dbConn, adOpenForwardOnly, adLockReadOnly
    txtEmpInfo = "[" & rs.Fields("dept_name").Value & "] " & rs.Fields("emp_name").Value
    txtW.Text = rs.Fields("w_days").Value
    txtL = rs.Fields("l_nums").Value
    txtE = rs.Fields("e_nums").Value
    txtH = rs.Fields("h_days").Value
    txtN = rs.Fields("n_days").Value
    txtO = rs.Fields("o_days").Value
    txtR = rs.Fields("r_days").Value
    txtOS = rs.Fields("overtime_s").Value
    txtCD = rs.Fields("d_check").Value
    txtDes = rs.Fields("check_des").Value
    rs.Close
    txtCD = Bhbx(txtCD)
    txtOS = Bhbx(txtOS)
End Sub
Private Sub Sxjl()
    '刷新工资信息
    Dim intP_salary As Integer
    Dim intF_salary As Integer
    
    strSql = "select a.b_salary,a.allowance,a.bonus,b.overtime_s,b.d_check,a.d_old,a.d_his,a.d_hou,a.p_salary,a.d_tax,a.f_salary  from salary a,checkin b where b.check_ym=a.check_ym and b.emp_id=a.emp_id and a.emp_id=clng('" & tEmp_id & "') and a.check_ym='" & tCheck_ym & "'"
    rs.Open strSql, dbConn, adOpenForwardOnly, adLockReadOnly
    If rs.EOF Then
        MsgBox ""
    Else
    intP_salary = rs.Fields("b_salary").Value + rs.Fields("allowance").Value + rs.Fields("bonus").Value - rs.Fields("d_old").Value - rs.Fields("d_his").Value - rs.Fields("d_hou").Value + rs.Fields("overtime_s").Value - rs.Fields("d_check").Value
    intF_salary = intP_salary - rs.Fields("d_tax").Value
    rs.Close
     strSql = "update salary set p_salary='" & intP_salary & "',f_salary='" & intF_salary & "',overtime_s='" & Trim(txtOS) & "',d_check='" & Trim(txtCD) & "' where emp_id=clng('" & tEmp_id & "') and check_ym='" & tCheck_ym & "' "
    dbConn.Execute strSql
    End If
End Sub