?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -