modulemain.bas

考勤机管理软件,用于统计某段时间某个部门或者某个员工在某段内迟到与早退次数.

                        ClassIDInfo(UBound(ClassIDInfo)).AddClass = False
                        ClassIDInfo(UBound(ClassIDInfo)).ClassID = OnClassInfo(i).ClassID
                    End If
                
                End If
                
'                ReDim Preserve ClassIDInfo(UBound(ClassIDInfo) + 1)
            End If
        
        End If
    Next

End Function

'==================用员工编号得出排班班次
Public Function GetSetClassID(ByVal Code As String, ByVal sDate As String)
    
    ReDim ClassIDInfo(1)
    blnClassIDInfo = True
    Dim j As Long
    Dim i As Long
    Dim X As Long
    Dim upBound As Long
    Dim lDate As Long
    lDate = Val(Mid(sDate, 1, 4)) * 600 + Val(Mid(sDate, 5, 2)) * 50 + Val(Mid(sDate, 7, 2))
    
    If blnSetClassInfo = True Then

        
    '    Dim iClassID As Long
    

        upBound = UBound(SetClassInfo)
        For i = 1 To upBound
        
            If SetClassInfo(i).CardID = Code Then
            
                
                
                If SetClassInfo(i).AddClass = True Then
                    If UBound(ClassIDInfo) = 1 Then
                         
                        If ClassIDInfo(UBound(ClassIDInfo)).ClassID = 0 Then
                            Call GetOnClassID(Code, sDate)
                        End If
    '                    ReDim Preserve ClassIDInfo(UBound(ClassIDInfo) + 1)
    '                    j = j + 1
                    End If
                   
                End If
                
                
            
                If lDate >= SetClassInfo(i).BeginDate And lDate <= SetClassInfo(i).EndDate Then
                
                    If ClassIDInfo(UBound(ClassIDInfo)).ClassID <> 0 Then ReDim Preserve ClassIDInfo(UBound(ClassIDInfo) + 1)
                    
                    If SetClassInfo(i).TimeMode = 0 Then
                    
                        ClassIDInfo(UBound(ClassIDInfo)).AddClass = SetClassInfo(i).AddClass
                        ClassIDInfo(UBound(ClassIDInfo)).ClassID = SetClassInfo(i).ClassID
                        
                    ElseIf SetClassInfo(i).TimeMode = 1 Then
                    
                        Dim dtm As Date
                        Dim iWeek As Integer
                        
                        dtm = CDate(Mid(sDate, 1, 4) & "-" & Mid(sDate, 5, 2) & "-" & Mid(sDate, 7, 2))
                        iWeek = Weekday(dtm)
                        
                        If iWeek = 1 Then iWeek = 7 Else iWeek = iWeek - 1
                               
                        If iWeek >= SetClassInfo(i).BeginTime And iWeek <= SetClassInfo(i).EndTime Then
                            ClassIDInfo(UBound(ClassIDInfo)).AddClass = SetClassInfo(i).AddClass
                            ClassIDInfo(UBound(ClassIDInfo)).ClassID = SetClassInfo(i).ClassID
                        End If
                    
                    ElseIf SetClassInfo(i).TimeMode = 2 Then
                    
                        Dim lDay As Long
                        lDay = Right(sDate, 2)
        
                        If (lDay >= SetClassInfo(i).BeginTime) And (lDay <= SetClassInfo(i).EndTime) Then
                            ClassIDInfo(UBound(ClassIDInfo)).AddClass = SetClassInfo(i).AddClass
                            ClassIDInfo(UBound(ClassIDInfo)).ClassID = SetClassInfo(i).ClassID
                        End If
                    
                    End If
                    
    '                ReDim Preserve ClassIDInfo(UBound(ClassIDInfo) + 1)
                End If
                
            End If
            
        Next
    
    End If
    
    If UBound(ClassIDInfo) = 1 Then
        If ClassIDInfo(1).ClassID = 0 Then
            Call GetOnClassID(Code, sDate)
'            ClassIDInfo(1).AddClass = False
'            ClassIDInfo(1).ClassID = GetClassID(Code)
        End If
    End If
     
End Function





'=================建立临时班次，排序，并且获得刷卡次数，===
Public Function GetClassCount() As Long
    Dim ClassIDCount As Long
    Dim ClassIDRow As Long
    
    Dim ClassCount As Long
    Dim ClassRow As Long
    g_GetTimeCount = 0
    g_AddClass = 0
    g_Memo = ""
    
    If blnClassIDInfo = False Then Exit Function
    ClassIDCount = UBound(ClassIDInfo)
    If blnClassInfo = False Then Exit Function
    ClassCount = UBound(ClassInfo)
    
    ReDim tmpClassInfo(1)
    blntmpClassInfo = True
    
    If ClassIDCount = 1 Then
        If ClassIDInfo(1).ClassID = 0 Then
            GetClassCount = 0
            Exit Function
        End If
    End If
    
    
    For ClassIDRow = 1 To ClassIDCount
        For ClassRow = 1 To ClassCount
            If ClassInfo(ClassRow).ClassID = ClassIDInfo(ClassIDRow).ClassID Then
                
                If tmpClassInfo(UBound(tmpClassInfo)).bTime <> 0 Then ReDim Preserve tmpClassInfo(UBound(tmpClassInfo) + 1)
                
                If ClassIDInfo(ClassIDRow).AddClass = True Then
                    g_AddClass = g_AddClass + 1
                End If
                
                tmpClassInfo(UBound(tmpClassInfo)).AddClass = ClassIDInfo(ClassIDRow).AddClass
                tmpClassInfo(UBound(tmpClassInfo)).ClassID = ClassIDInfo(ClassIDRow).ClassID
                tmpClassInfo(UBound(tmpClassInfo)).bTime = ClassInfo(ClassRow).InTime
                tmpClassInfo(UBound(tmpClassInfo)).eTime = ClassInfo(ClassRow).OutTime
                
'                ReDim Preserve tmpClassInfo(UBound(tmpClassInfo) + 1)
                
            End If
        Next
        
'        MsgBox ClassIDInfo(ClassIDRow).ClassID
    Next
    
    
    Dim tmpClassCount As Long
    Dim tmpClassIndex As Long
    Dim tmpClassNext As Long
    
    Dim tmpbtime As Long
    Dim tmpetime As Long
    Dim tmpClassID As Long
    Dim tmpbln As Boolean
    g_Memo = "加班:"
    
    If blntmpClassInfo = False Then Exit Function
    tmpClassCount = UBound(tmpClassInfo)
    
    For tmpClassIndex = 1 To tmpClassCount - 1
        For tmpClassNext = tmpClassIndex + 1 To tmpClassCount

            If tmpClassInfo(tmpClassIndex).bTime > tmpClassInfo(tmpClassNext).bTime Then
            


                tmpbln = tmpClassInfo(tmpClassIndex).AddClass
                tmpbtime = tmpClassInfo(tmpClassIndex).bTime
                tmpetime = tmpClassInfo(tmpClassIndex).eTime
                tmpClassID = tmpClassInfo(tmpClassIndex).ClassID
                
                tmpClassInfo(tmpClassIndex).AddClass = tmpClassInfo(tmpClassNext).AddClass
                tmpClassInfo(tmpClassIndex).bTime = tmpClassInfo(tmpClassNext).bTime
                tmpClassInfo(tmpClassIndex).eTime = tmpClassInfo(tmpClassNext).eTime
                tmpClassInfo(tmpClassIndex).ClassID = tmpClassInfo(tmpClassNext).ClassID
                
                tmpClassInfo(tmpClassNext).ClassID = tmpClassID
                tmpClassInfo(tmpClassNext).AddClass = tmpbln
                tmpClassInfo(tmpClassNext).bTime = tmpbtime
                tmpClassInfo(tmpClassNext).eTime = tmpetime

            End If

        Next
    Next
    
    For tmpClassIndex = 1 To tmpClassCount
        
        If tmpClassIndex + 1 <= tmpClassCount Then
            If tmpClassInfo(tmpClassIndex + 1).bTime <= tmpClassInfo(tmpClassIndex).eTime Then
                g_Memo = "时间段设置有冲突!"
                GetClassCount = -1
                Exit Function
            End If
        End If
        
        If tmpClassInfo(tmpClassIndex).AddClass = True Then
            g_Memo = g_Memo & "时间段" & tmpClassIndex & ","
        End If
    Next
    
    If g_Memo = "加班:" Then g_Memo = "" Else g_Memo = Left(g_Memo, Len(g_Memo) - 1)
    
    
    g_GetTimeCount = tmpClassCount
    GetClassCount = (tmpClassCount) * 2

End Function

'===========利用时间，得到应当插入的位置
Public Function GetTimePos(ByVal Time As String) As Long
    

    Dim MidTime As Integer
    Dim iTime  As Integer
    iTime = Val(Mid(Time, 1, 2)) * 60 + Val(Mid(Time, 3, 4))

    Dim i As Integer
    Dim j As Integer
    Dim X As Integer
    Dim tmpClassCount As Integer
    
    
    If blntmpClassInfo = False Then Exit Function
    tmpClassCount = UBound(tmpClassInfo)
    For i = 1 To tmpClassCount
    
'        If tmpClassInfo(i).AddClass = True Then
'            g_Memo = g_Memo & "时间段" & i & ","
'        End If
        If tmpClassInfo(i).bTime <= tmpClassInfo(i - 1).eTime Then
            GetTimePos = -1
            Exit Function
        End If
    

        If X <> 0 Then
            j = j + 1
            MidTime = (tmpClassInfo(i).bTime - tmpClassInfo(X).eTime) / 2 + tmpClassInfo(X).eTime
            X = 0
        End If

        If iTime < MidTime Then
            GetTimePos = j
            Exit Function
        End If

        If X = 0 Then
            j = j + 1

            MidTime = (tmpClassInfo(i).eTime - tmpClassInfo(i).bTime) / 2 + tmpClassInfo(i).bTime
            X = i
        End If

        If iTime < MidTime Then
            GetTimePos = j
            Exit Function
        End If

    Next

    GetTimePos = (tmpClassCount) * 2

End Function

' ==========判断是否迟到或旷工========正常返回0,迟到早退返回1,旷工返回2
Public Function GetTimeState(ByVal Time As String, ByVal TimePos As Long, ByVal Late As Long, ByVal Absent As Long) As Integer
    
    
    If blntmpClassInfo = False Then Exit Function
    
    Dim iTime  As Integer
    iTime = Val(Mid(Time, 1, 2)) * 60 + Val(Mid(Time, 3, 4))

    Dim upBound As Long
    upBound = UBound(tmpClassInfo)

    Dim i As Integer
    Dim j As Integer
    Dim iTimePos As Integer
    g_LateTime = 0
    For i = 1 To upBound

        j = j + 1

        If TimePos Mod 2 = 1 Then
            iTimePos = (TimePos + 1) / 2
            If j = iTimePos Then
                g_LateTime = iTime - tmpClassInfo(i).bTime

                If (tmpClassInfo(i).bTime + Absent) < (iTime) Then
                    GetTimeState = 2
                    Exit Function
                End If

                If (tmpClassInfo(i).bTime + Late) < (iTime) Then
                    GetTimeState = 1
                    Exit Function
                End If

            End If
        End If

        If TimePos Mod 2 = 0 Then
            iTimePos = TimePos / 2
            If j = iTimePos Then
                g_LateTime = iTime - tmpClassInfo(i).eTime

                If (tmpClassInfo(i).eTime - Absent) > (iTime) Then
                    GetTimeState = 2
                    Exit Function
                End If

                If (tmpClassInfo(i).eTime - Late) > (iTime) Then
                    GetTimeState = 1
                    Exit Function
                End If

            End If
        End If

    Next
    GetTimeState = 0
    
End Function


'========用班次编号得出班次名称
Public Function GetClassName(ByVal ClassID As Long) As String
    If blnClassInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(ClassInfo)
    
    Dim i As Integer
    For i = 1 To upBound
        If ClassInfo(i).ClassID = ClassID Then
            GetClassName = ClassInfo(i).ClassName
            Exit Function
        End If
    Next
    
    GetClassName = ""
    
End Function

'========用员工编号得出员工名称
Public Function GetEmployeeName(ByVal Code As String) As String
    If blnEmployeeInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(EmployeeInfo)
    
    Dim i As Integer
    For i = 1 To upBound
        If EmployeeInfo(i).CardID = Code Then
            GetEmployeeName = EmployeeInfo(i).EmployeeName
            Exit Function
        End If
    Next
    
    GetEmployeeName = ""
    
End Function

'=============用日期,员工号,得出第一条时间
Public Function FindFristTime(ByVal InDate As String, ByVal InCode As String) As Integer
    If blnInDataInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(InDataInfo)
    
    Dim i As Integer
    For i = 1 To upBound
        If InDataInfo(i).InDate = InDate And InDataInfo(i).InCode = InCode Then
            FindFristTime = i
            Exit Function
        End If
    Next
    
    FindFristTime = 0
    
End Function

'========用员工编号得出相应排班下一条信息
Public Function FindNextTime(ByVal InDate As String, ByVal InCode As String, ByVal Index As Integer) As Integer
    If blnInDataInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(InDataInfo)
    
    Dim i As Integer
    For i = Index + 1 To upBound
        If InDataInfo(i).InDate = InDate And InDataInfo(i).InCode = InCode Then
            FindNextTime = i
            Exit Function
        End If
    Next
    
    FindNextTime = 0

End Function


'=========用员工编号得出默认班次
Public Function GetClassID(ByVal Code As String) As Long
    If blnEmployeeInfo = False Then Exit Function
    Dim upBound As Long
    upBound = UBound(EmployeeInfo)
    
    Dim i As Integer
    For i = 1 To upBound
        If EmployeeInfo(i).CardID = Code Then
            GetClassID = EmployeeInfo(i).OnClassID
            Exit Function