Buyrun, Rapor Ek'tedir.
Kod:
Private Sub Report_Open(Cancel As Integer)
On Error GoTo Hata_Olusursa
Dim RS As New ADODB.Recordset
Dim GS As New ADODB.Recordset
Dim Onceki_Personel, Onceki_GC
'Geçici tabloda bulunan eski kayıtlar siliniyor.
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete From LOG_Gecici"
DoCmd.SetWarnings True
'Asıl Log Tablosu okuma için açılıyor
RS.Open "GirisCikis", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
'Geçici LOG Tablosu yazma için açılıyor
GS.Open "LOG_Gecici", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
Do While Not RS.EOF
'Personel değiştiğinde bir önceki bilgiler sıfırlanıyor.
If Onceki_Personel <> RS("Personel") Then
Onceki_Personel = RS("Personel")
Onceki_GC = Null
End If
'Giriş İşleminde tabloya çıkışı boş olan yeni kayıt yazılıyor
If RS("GC") = 0 Then
GS.AddNew
GS("Personel") = RS("Personel")
GS("GirisZamani") = RS("Zaman")
GS("CikisZamani") = Null
GS.Update
Else
'Çıkış İşlemi
'Bir önceki işlem Giriş ise aynı kayda çıkış zamanı yazılıyor ve son giriş kaydı güncelleniyor
If Onceki_GC = 0 Then
GS("CikisZamani") = RS("Zaman")
GS.Update
End If
'Bir önceki işlem yoksa veya çıkış ise yeni ve girişi boş olan çıkış kaydı yazılıyor
If IsNull(Onceki_GC) Or Onceki_GC = 1 Then
GS.AddNew
GS("Personel") = RS("Personel")
GS("GirisZamani") = Null
GS("CikisZamani") = RS("Zaman")
GS.Update
End If
End If
'Yeni kayıt okumadan önce mevcut bilgi önceki olarak saklanıyor
Onceki_GC = RS("GC")
RS.MoveNext
Loop
RS.Close
GS.Close
Normal_Cikis:
Exit Sub
Hata_Olusursa:
MsgBox Err.Description
Resume Normal_Cikis
End Sub