?? 復(fù)件 frm_kaoqihesuan.frm
字號:
Private Sub GurhanButton1_Click(Index As Integer)
'On Error GoTo Err1
On Error Resume Next
Dim mancount As Integer
Dim i As Integer
ReDim mvList(List1.ListCount - 1)
'Dim strList As String
'strList = ""
For i = 0 To List1.ListCount - 1
mvList(i) = List1.List(i)
'strList = strList & "'" & List1.List(i) & "'" & ","
'Debug.Print mvList(i)
Next i
'strList = Left(strList, Len(strList) - 1)
'Dim bgtm As Date
'Dim t1 As Integer
'Dim Maxid As Long
'
'strSQL = "select max(crdtmid) as maxid from empcrdtm"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'If IsNull(adoprimaryRS.Fields("maxid").Value) Then
' Maxid = 1
'Else
' Maxid = adoprimaryRS.Fields("maxid").Value
'End If
'' strSQL = "select top 10 * from empcrdtm" '''''自動考勒所用的表;
' strSQL = "select * from empcrdtm where 1=2"
' Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Dim sBuMen As String
'For i = 0 To List1.ListCount - 1
'sBuMen = sBuMen & "'" & List1.List(i) & "',"
'Next i
'If Len(sBuMen) > 2 Then
'sBuMen = Left(sBuMen, Len(sBuMen) - 1)
'Else
'sBuMen = ""
'End If
'Debug.Print sBuMen
Select Case Index
Case 0
strSQL2 = "delete from emplytmp"
mDB.ExecuteSQL strSQL2
For i = 0 To List1.ListCount - 1
strSQL2 = "insert into emplytmp select emplyid,serial from emply,depart where depart.dptid=emply.dptid and emply.empcrdyn=1 and dptname ='" & List1.List(i) & "'"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
Next i
strSQL2 = "select * from emplytmp"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
mancount = adoPrimaryRS2.RecordCount
'strSQL2 = "select emplytmp.emplyid,emplytmp.serial from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "' amd ((outdate is null) or (outdate<'" & DTPicker1(0).Value & "'))"
strSQL2 = "delete from emplytp"
mDB.ExecuteSQL strSQL2
'strSQL2 = "insert into emplytp select emplytmp.emplyid,emplytmp.serial from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "' and outdate<='" & DTPicker1(0).Value & "'"
strSQL2 = "insert into emplytp(emplyid,serial,indate,outdate) select emplytmp.emplyid,emplytmp.serial,indate,outdate from emplytmp,emply2 where emplytmp.emplyid=emply2.emplyid and indate<='" & DTPicker1(0).Value & "'"
mDB.ExecuteSQL strSQL2
'strSQL2 = "select emplytp.emplyid,serial from emplytp,emply2 where emplytp.emplyid=emply2.emplyid and ((outdate is null) or (outdate>'" & DTPicker1(0).Value & "'))"
'strSQL2 = "select emplytp.emplyid,serial from emplytp where (outdate is null) or (outdate>'" & DTPicker1(0).Value & "')"
' strSQL2 = "select c.dptname,b.emplyid,b.emplyname,a.indate,a.outdate,left(d.wktmbg,10) as bgdate,e.wktmdays,e.regualorder from emplytp a,emply b,depart c,empwktm d,wktmregual e,wktm f where b.emplyid=d.emplyid and d.regualid=e.regualid and e.wktmid=f.wktmid and a.emplyid=b.emplyid and b.dptid=c.dptid"
strSQL2 = "select c.dptid,c.dptname,b.emplyid,b.emplyname,a.indate,a.outdate,left(d.wktmbg,10) as bgdate,d.regualid from emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid and a.emplyid=b.emplyid and b.dptid=c.dptid"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
If adoPrimaryRS2.RecordCount = 0 Then
MsgBox "你所選擇的部門無員工,請重新選擇。謝謝。", vbOKOnly, "NewAsia"
Exit Sub
Else
If MsgBox("共有" & mancount & "_" & adoPrimaryRS2.RecordCount & "人參與考勤核算", vbYesNo, "NewAsia") = vbNo Then
Screen.MousePointer = 0
Exit Sub
End If
End If
ReDo:
strSQL = "delete from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid in (select b.emplyid from emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid and a.emplyid=b.emplyid and b.dptid=c.dptid)"
mDB.ExecuteSQL strSQL
strSQL = "select count(*) from wktmrslt where caldate between '" & DTPicker1(0).Value & "' and '" & DTPicker1(1).Value & "' and emplyid in (select b.emplyid from emplytp a,emply b,depart c,empwktm d where b.emplyid=d.emplyid and a.emplyid=b.emplyid and b.dptid=c.dptid)"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
If adoprimaryRS(0).Value Then GoTo ReDo
Dim nCount As Long '''''''''核算進(jìn)度(已核算人數(shù))
Screen.MousePointer = 11
strSQL = "select max(ID) from wktmrslt"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
Dim Maxid As Long
Maxid = adoprimaryRS(0).Value
strSQL = "select * from wktmsys"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
Dim tChiDao As Integer ' 遲到
Dim tZaoTui As Integer ' 早退
Dim tChiDao2 As Integer ' 在上班 分鐘后記曠工;
Dim tZaoTui2 As Integer ' 在下班 分鐘后記曠工;
Dim tWuXiao As Integer ' 前后兩次打卡在 分鐘內(nèi)記為無效打卡;
Dim iFen As Integer ' 在下班 分鐘后打卡記加班有效;(在允許延時加班的情況下)
With adoprimaryRS
.Filter = "sysid=1"
tChiDao = .Fields("condition").Value
.Filter = "sysid=2"
tZaoTui = .Fields("condition").Value
.Filter = "sysid=3"
tChiDao2 = .Fields("condition").Value
.Filter = "sysid=4"
tZaoTui2 = .Fields("condition").Value
.Filter = "sysid=5"
tWuXiao = .Fields("condition").Value
.Filter = "sysid=6"
iFen = .Fields("condition").Value
End With
strSQL3 = "select e.wktmid,f.wktmdecs,e.wktmdays,e.regualorder,f.hours,e.regualid,bgnwktm1,bgntm1,endtm1,endwktm1,bgnwktm2,bgntm2,endtm2,endwktm2,bgnwktm3,bgntm3,endtm3,endwktm3 from wktmregual e,wktm f where e.wktmid=f.wktmid order by e.regualorder"
Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)
' Debug.Print adoPrimaryRS3.RecordCount
Dim iZQ As Integer ''''周期
Dim bgnwktm1 As Date
Dim bgntm1 As Date
Dim endtm1 As Date
Dim endwktm1 As Date
Dim bgnwktm2 As Date
Dim bgntm2 As Date
Dim endtm2 As Date
Dim endwktm2 As Date
Dim bgnwktm3 As Date
Dim bgntm3 As Date
Dim endtm3 As Date
Dim endwktm3 As Date
Dim bgntm11 As Date
Dim bgntm22 As Date
Dim fromD As Date
Dim toD As Date
iZQ = adoPrimaryRS3("wktmdays").Value
Dim ii As Integer
Dim JJ As Integer
Dim iJS As Integer
Dim n As Integer
Dim iCount As Integer
iCount = DTPicker1(1).Value - DTPicker1(0).Value
Dim d As Date
Dim dd As Date
Dim iStart As Integer
Dim nm As Long
strSQL4 = "select * from empcrdtm where cdatetime>'" & DTPicker1(0).Value & "' and cdatetime<'" & DTPicker1(1).Value + 1 & "' order by cdatetime"
Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)
strSQL5 = "select * from wktmrslt where 1=2"
Set adoPrimaryRS5 = mDB.adoRSBatch(strSQL5)
With adoPrimaryRS2
.MoveFirst
Do While Not .EOF
d = DTPicker1(0).Value
dd = d
iStart = DateDiff("d", .Fields("bgdate").Value, d) Mod iZQ
' iStart = Abs(DateDiff("d", .Fields("bgdate").Value, d) Mod iZQ)
If iStart < 0 Then
iStart = iStart + iZQ
End If
' Debug.Print DateDiff("d", .Fields("bgdate").Value, d)
' ii = iStart + 1
'ii = iStart
'If ii = 0 Then ii = 1
ii = iStart + 1
If ii = 0 Then ii = iZQ
' Debug.Print ii
StatusBar1.Panels(2).Text = .Fields("emplyname").Value
StatusBar1.Panels(4).Text = .Fields("emplyid").Value
' nm = nm + 1
' StatusBar1.Panels(3).Text = nm
adoPrimaryRS3.Filter = "regualid=" & adoPrimaryRS2.Fields("regualid").Value
For i = 0 To iCount '''''核算天數(shù)
'''''''''''''''''***************************************
'''''未進(jìn)廠 或 已離職;
If .Fields("indate").Value > d Or (Not IsNull(.Fields("outdate").Value) And .Fields("indate").Value <= d) Then
GoTo Next1
End If
'''''''''''''''''***************************************
StatusBar1.Panels(5).Text = d
'Debug.Print adoPrimaryRS3.RecordCount
adoPrimaryRS3.Find "regualorder=" & ii, 0, adSearchForward, adBookmarkFirst
' adoPrimaryRS3.Find "regualorder=" & ii, 0, adSearchForward, adBookmarkFirst
bgnwktm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgnwktm1").Value, 11)
bgntm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgntm1").Value, 11)
endtm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endtm1").Value, 11)
endwktm1 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endwktm1").Value, 11)
bgnwktm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgnwktm2").Value, 11)
bgntm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("bgntm2").Value, 11)
endtm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endtm2").Value, 11)
endwktm2 = CStr(d) & " " & Mid(adoPrimaryRS3.Fields("endwktm2").Value, 11)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -