frmdealdata.frm

人事管理系统的一个比较不错的VB软件 有管理系统的功能

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmDealData 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "日考勤处理"
   ClientHeight    =   4380
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6285
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4380
   ScaleWidth      =   6285
   Begin VB.ListBox ListDispDeal 
      Height          =   2400
      Left            =   120
      TabIndex        =   9
      Top             =   1800
      Width           =   6015
   End
   Begin VB.CommandButton cmdDeal 
      Caption         =   "开始处理"
      Height          =   375
      Left            =   2400
      TabIndex        =   8
      Top             =   1200
      Width           =   1215
   End
   Begin MSComCtl2.DTPicker DTPDealDate 
      Height          =   375
      Index           =   1
      Left            =   4440
      TabIndex        =   7
      Top             =   620
      Width           =   1500
      _ExtentX        =   2646
      _ExtentY        =   661
      _Version        =   393216
      Format          =   27000833
      CurrentDate     =   38133
   End
   Begin MSComCtl2.DTPicker DTPDealDate 
      Height          =   375
      Index           =   0
      Left            =   1440
      TabIndex        =   6
      Top             =   620
      Width           =   1500
      _ExtentX        =   2646
      _ExtentY        =   661
      _Version        =   393216
      Format          =   27000833
      CurrentDate     =   38133
   End
   Begin VB.TextBox txtItem 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Index           =   1
      Left            =   4440
      MaxLength       =   6
      TabIndex        =   5
      Text            =   "999999"
      Top             =   120
      Width           =   1000
   End
   Begin VB.TextBox txtItem 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Index           =   0
      Left            =   1440
      MaxLength       =   6
      TabIndex        =   4
      Text            =   "000000"
      Top             =   120
      Width           =   1000
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "处理日期止"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3200
      TabIndex        =   3
      Top             =   720
      Width           =   1125
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "处理日期起"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   200
      TabIndex        =   2
      Top             =   720
      Width           =   1125
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "处理工号止"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   3200
      TabIndex        =   1
      Top             =   220
      Width           =   1125
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "处理工号起"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   200
      TabIndex        =   0
      Top             =   220
      Width           =   1125
   End
End
Attribute VB_Name = "frmDealData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const PaleTime = 60  '刷卡时间范围
Const LateTime = 60  '迟到时间范围
Public mrc As ADODB.Recordset
Dim txtSql As String
Dim arrayPeriod() As Double   '上班时段数组
Dim nCountPeriod  As Double   '一天的上班时数
Dim nPeriodRecord As Integer  '有几个时段






Private Sub cmdDeal_Click()
    Dim mrcEmployee, mrcTemp As ADODB.Recordset
    Dim txtTempId, txtTempName As String  '临时变量
    Dim tempDealDate As Date '处理日期
    Dim DealFlag, tempflag As Boolean '处理标志
    Dim nDay As Integer '星期几
    
    '检查处理条件数据
    If Not check_dealData Then
       Exit Sub
    End If
   
    tempDealDate = DTPDealDate(0).Value '处理 开始日期
    
    Do While tempDealDate <= DTPDealDate(1).Value
           
       DealFlag = False '初始处理标志设这不处理
       
       '判断星期几
       DealFlag = JudgeWeekDay(tempDealDate)
       
       tempflag = DealFlag
       
       '判断这天是否特别处理
       DealFlag = JudgeFeria(tempDealDate, tempflag)
        
       
       '处理每日数据
       If DealFlag Then
       
          txtSql = "select Id , Name from employee where Id>='" & txtItem(0).Text & "' and Id <= '" & txtItem(1).Text & "'"
          
          Set mrcEmployee = Nothing
          Set mrcEmployee = ExecuteSQL(txtSql)
          Do While Not mrcEmployee.EOF
             txtTempId = mrcEmployee.Fields(0).Value
             txtTempName = mrcEmployee.Fields(1).Value
             '处理一个员工日考勤
             tempFalg = JudgeId(tempDealDate, txtTempId, txtTempName)
             
             txtSql = "select * from abnormity where Id ='" & txtTempId & "' and DealDate='" & tempDealDate & "'"
             Set mrc = Nothing
             Set mrc = ExecuteSQL(txtSql)
             
             If mrc.EOF Then
                 ListDispDeal.AddItem tempDealDate & txtTempId & txtTempName & "正常上班"
             Else
                 ListDispDeal.AddItem tempDealDate & txtTempId & txtTempName & "上班异常"
             End If
           
             mrcEmployee.MoveNext
          Loop
       
       End If
       
       tempDealDate = tempDealDate + 1
    Loop
    
    MsgBox "处理成功!!"
    
   
End Sub
'员工日考勤处理
Private Function JudgeId(vtDate As Date, ByVal vtId As String, ByVal vtName As String) As Boolean
   Dim txtHoliday As String  '请假原因代号
   Dim nTime As Double
   Dim saveFlag As Boolean
   Dim txtMonth As String  '处理月份
   Dim nDay As Integer
 
   '预置处理正常
   JudgeId = True
   
   txtMonth = Format(vtDate, "yyyymm") '处理月份
   nDay = Val(Format(vtDate, "dd"))
   
   txtHoliday = JudgeHoliday(vtId, vtDate)
   
   If txtHoliday = "" Then
      '没有请假处理考勤资料
      nTime = JudgeDayData(vtId, vtDate)
      
      saveFlag = SaveDayData(vtId, txtMonth, nDay, nTime)
   Else
      '有请假处理请假处理
      If txtHoliday < "20" Then
         '带薪请假
         saveFlag = SaveDayData(vtId, txtMonth, nDay, nCountPeriod)
         
      Else
         '无薪请假
         saveFlag = SaveDayData(vtId, txtMonth, nDay, 0)
      End If
     
   End If
   
   
End Function
'处理日考勤
Private Function JudgeDayData(vtId As String, vtDate As Date) As Double
   Dim i As Integer
   Dim beginTime, endTime As Double
   Dim begintxt, endtxt As String
   Dim FlagBegin, FlagEnd, FlagBegin1, FlagEnd1 As Boolean
   Dim txtBegin, txtEnd, txtBegin1, txtEnd1 As String
   Dim n1, n2, n3 As Integer
   
   
   
   JudgeDayData = 0
   
   n1 = 0 '迟到
   n2 = 0 '早退
   n3 = 0 '旷工
   
   For i = 0 To nPeriodRecord - 1
        
      FlagBegin = False  '正常上班
      FlagEnd = False  '迟到
      FlagBegin1 = False '正常下班
      FlagEnd1 = False  '早退
      txtBegin = ""
      txtBegin1 = ""
      txtEnd = ""
      txtEnd1 = ""
        
      beginTime = arrayPeriod(i, 0)
      endTime = arrayPeriod(i, 1)
      
      begintxt = DoubleToTimeStr(beginTime - PaleTime)
      endtxt = DoubleToTimeStr(beginTime)
      '上班刷卡
      txtSql = "select * from daydata where Id ='" & vtId & "' and BrushDate='" & vtDate & "' and BrushTime>='" & begintxt & "' and BrushTime <='" & endtxt & "'"
      
      Set mrc = Nothing
      
      Set mrc = ExecuteSQL(txtSql)
      
      If Not mrc.EOF Then
         FlagBegin = True
         txtBegin = mrc.Fields(2).Value
      Else
         begintxt = DoubleToTimeStr(beginTime)
         endtxt = DoubleToTimeStr(beginTime + LateTime)
         '上班迟到刷
         txtSql = "select * from daydata where Id ='" & vtId & "' and BrushDate='" & vtDate & "' and BrushTime>='" & begintxt & "' and BrushTime <='" & endtxt & "'"
      
         Set mrc = Nothing