عجيب .. عجيب
يبدو انك عدلت على شيء ما
اعدت التجربة .. والنتيجة كانت مذهلة
التعديلات التي اجراها :
تنظيم الكود .. بحيث جعل جميع الاعلانات عن المتغيرات في الأعلى
بدل شرط الحقل النصي في الدوال بالمتغير وكذلك في جملة sql استبدل الدالة بالمتغير .. عفريت برمجي
اضاف لي متغير اسم الموظف غفلت عن نقله من العمل السابق ... هذه الاضافة لا تخطر على بال المحترفين الا بعد عناء
اغلاق السجلات عند نهاية كل شرط .. الحقيقة هذه الحركة تحفة
هذه صورة من الخيارات التي استخدمتها :
وهذا الكود الاصلي :
Private Sub id_AfterUpdate()
EmpUserid = id
Dim mylevl As Boolean
mylevl = Nz(DLookup("Emp_user", "tblEmpNames", "Emp_user='" & Me.id & "'"), 0)
EmpFatrah = Nz(DLookup("fatrah", "tblEmpNames", "Emp_user='" & Me.id & "'"), 0)
If mylevl = False Then
Beep
Me.LabelH.Caption = "خطأ!! .. الادخال غير صحيح"
Me.TimerInterval = 3000
id = ""
id.SetFocus
Exit Sub
End If
Dim rs As Recordset
Dim strSql As String
strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " & vbCrLf & _
"FROM tblCheckINOut " & vbCrLf & _
"WHERE (((tblCheckINOut.EmpUser)=funEmpUserid())) " & vbCrLf & _
"ORDER BY tblCheckINOut.id DESC;"
Set rs = CurrentDb.OpenRecordset(strSql)
If rs.RecordCount = 0 Then
rs.AddNew
rs!EmpUser = id
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
Exit Sub
End If
Dim waitTime As Integer
Dim AdTim As Date
waitTime = Nz(DLookup("waitBtween", "tblTimeCtrl"), 0)
AdTim = DateAdd("n", waitTime, rs!chekInOut)
If Now() < AdTim Then
Me.id.SetFocus
Beep
Me.LabelH.Caption = "توقيع مكرر !! انتظر قليلا ..."
id = ""
Me.TimerInterval = 3000
id.SetFocus
Exit Sub
Else
If rs!chkio = "I" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "O"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "انصراف"
Me.Requery
Me.id = ""
Me.TimerInterval = 3000
Me.id.SetFocus
rs.Update
Exit Sub
ElseIf rs!chkio = "O" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
Exit Sub
End If
End If
End Sub
وهذه هي النتيجة الرائعة :
Private Sub id_AfterUpdate()
Dim EmpUserid As Variant
Dim mylevl As Boolean
Dim EmpFatrah As Variant
Dim rs As DAO.Recordset
Dim strSql As String
Dim waitTime As Integer
Dim AdTim As Date
Dim empName As String ' Declare empName
EmpUserid = Me.id
' Corrected logic for mylevl to check for user existence
mylevl = Not IsNull(DLookup("Emp_user", "tblEmpNames", "Emp_user='" & EmpUserid & "'"))
EmpFatrah = Nz(DLookup("fatrah", "tblEmpNames", "Emp_user='" & EmpUserid & "'"), 0)
If mylevl = False Then
Beep
Me.LabelH.Caption = "خطأ!! .. الادخال غير صحيح"
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
Exit Sub
End If
' Lookup empName once after confirming user existence
empName = Nz(DLookup("Emp_Name", "tblEmpNames", "Emp_user='" & EmpUserid & "'"), "")
strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " & vbCrLf & _
"FROM tblCheckINOut " & vbCrLf & _
"WHERE (((tblCheckINOut.EmpUser)='" & EmpUserid & "')) " & vbCrLf & _
"ORDER BY tblCheckINOut.id DESC;"
Set rs = CurrentDb.OpenRecordset(strSql)
If rs.RecordCount = 0 Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
Me.LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
rs.Close
Set rs = Nothing
Exit Sub
End If
waitTime = Nz(DLookup("waitBtween", "tblTimeCtrl"), 0)
AdTim = DateAdd("n", waitTime, rs!chekInOut)
If Now() < AdTim Then
Me.id.SetFocus
Beep
Me.LabelH.Caption = "توقيع مكرر !! انتظر قليلا ..."
Me.id = ""
Me.TimerInterval = 3000
Me.id.SetFocus
rs.Close
Set rs = Nothing
Exit Sub
Else
If rs!chkio = "I" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "O"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
Me.LabelH.Caption = "انصراف"
Me.Requery
Me.id = ""
Me.TimerInterval = 3000
Me.id.SetFocus
rs.Update
rs.Close
Set rs = Nothing
Exit Sub
ElseIf rs!chkio = "O" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
Me.LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
rs.Close
Set rs = Nothing
Exit Sub
End If
End If
End Sub
صحيح هو اضاف لي هذا المتغير :
Dim EmpUserid As Variant
ولكن هذا المتغير تم الاعلان عنه في الوحدة النمطية كمتغير عام
وانا لا الومه لانه لا يعلم وليس له الا الظاهر ☺️