حضور وانصراف الموظفين .. فترات محكمة خلال يوم .. وتمتد لليوم التالي

[ابوخليل]

السلام عليكم

بفضل الله تمكنت من ايجاد طريقة ممتازة ومحكمة للتعامل مع توقيع الحضور والانصراف للفترة المسائية  الممتدة الى ما بعد منتصف الليل ودخول يوم جديد

انتظروني بعض الوقت كي اجري تجاربي النهائية على العمليات وعلى المخرجات .

[مهند محسن]

أحسنت استاذنا الكريم فى الإنتظار . بالنجاح والتوفيق دائما ان شاء الله

[Foksh]

4 ساعات مضت, ابوخليل said:

السلام عليكم

بفضل الله تمكنت من ايجاد طريقة ممتازة ومحكمة للتعامل مع توقيع الحضور والانصراف للفترة المسائية  الممتدة الى ما بعد منتصف الليل ودخول يوم جديد

انتظروني بعض الوقت كي اجري تجاربي النهائية على العمليات وعلى المخرجات .

وعليكم السلام ورحمة الله وبركاته..

اذا ليس هناك داعي للفترة الثالثة ؟؟

ننتظر ابداعك وتميزك معلمي الفاضل 🤗

[ابوخليل]

1 ساعه مضت, Foksh said:

اذا ليس هناك داعي للفترة الثالثة ؟؟

نعم .. تماما

السر في هذه الدالة التي حلت المشكلة

الدالة تتحدث وليست بحاجة الى شرح  .. حيث تفحص الوقت الحالي هل هو في مساء اليوم  ام لا

  Dim startTime As Date
  Dim endTime As Date
  Dim currentTime As Date
  Dim i As Integer
  startTime = TimeValue("12:01:00")
  endTime = TimeValue("23:59:59")
  currentTime = Time()
  If currentTime > startTime And currentTime < endTime Then
     i = 1
     Else
     i = 2
     End If
 CheckTimeBetween = i

وكان السبب الرئيس في المشكلة هو دالة توقيت المساء سواء الحضور او الانصراف

لأنه عند دخول اليوم التالي يعتبر الدخول المسائي ضمن مساء الغد

لهذا تم تعديل دالتي التوقيت المسائي وفقا لهذه الدالة اعلاه  انظروا  كيف تتعامل الدالتان ادناه

الشرط يقول : اذا الوقت الحالي داخل في شرط الدالة وصحيح .. اي =1 فالتاريخ تاريخ اليوم

وإلا فإن التاريخ هو تاريخ  الأمس

Public Function funFirstTimeB_in()
Dim z As Integer
Dim i As Date, ii As Date, jj As Date
z = Nz(DLookup("free2_in", "tblTimeCtrl"), 0)
If CheckTimeBetween() = 1 Then
i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & Date
ii = DateAdd("n", -z, i)
 Else
 jj = DateAdd("d", -1, Date)
 i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & jj
 ii = DateAdd("n", -z, i)
   End If
funFirstTimeB_in = ii
End Function

Public Function funLastTimeB_Out()
Dim z As Integer
Dim x As Integer, xx As Integer
Dim i As Date, ii As Date, jj As Date
z = Nz(DLookup("free2_out", "tblTimeCtrl"), 0)
x = Nz(DLookup("hours_Work2", "tblTimeCtrl"), 0)
xx = (x * 60) + z
If CheckTimeBetween() = 1 Then
 i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & Date
ii = DateAdd("n", xx, i)
 Else
 jj = DateAdd("d", -1, Date)
 i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & jj
 ii = DateAdd("n", xx, i)
   End If
  funLastTimeB_Out = ii
End Function

 

للتجربة والتأكد ان كل شيء تمام  جعلت عند التوقيع  في الفترتين كليهما .. تظهر رسالتان الاولى لبداية التوقيع والثانية لنهايته

اذا الامور تمام يمكنك تعطيل وايقاف هذه الرسائل

بداية التوقيع = وقت الدخول الرسمي - الوقت المتاح قبل

نهاية التوقيع = وقت الدخول الرسمي + عدد ساعات العمل + الوقت المتاح بعد

جعلت الاوقات المتاحة بالدقائق من اجل دقة الاختيار

 

[ابوخليل]

بالنسبة للتوقيع فهو مفتوح

الاول حضور والثاني خروج .. ويمكن تكرار الدخول والخروج عدة مرات في الفترة الواحدة

اما خارج الوقت المتاح للفترة فلا يمكن التوقيع

بقي شيء لم اتأكد منه هل سيوقع انصراف في الغد لو لم يتمكن من التوقيع اليوم بسبب خروج الوقت  .. هذه ثغرة يجب ان اتأكد منها .. لأنه يجب ان يبقى حقل الانصراف فارغا

ويسجل له دخول جديد

[ابوخليل]

نعم الثغرة موجودة .. يجب معالجتها

لذا حذفت المرفق .. من اجل التعديل والاصلاح

[Foksh]

ما شاء الله .. فكرة جميلة ومحكمة لتلافي مشكلة الفترة المسائية ( تسجيل الحضور في يوم ، والخروج في اليوم التالي ) ..

وبما أنك اكتشفت ثغرة ، فاسمح لي باقتراح وملاحظة بسيطين أيضاً ، وهو أنني لاحظت من خلال الدالتين انهما تستخدمان DLookup في كل عملية ما يقارب 7 مرات . ومع وجود حدث التايمر في النموذج .....   

حيث يمكن التعديل بحيث نستخدم استدعاء DLookup تقريباً 3 مرات تقريباً عند كل عملية تسجيل حضور أو انصراف .

[ابوخليل]

2 دقائق مضت, Foksh said:

ما شاء الله .. فكرة جميلة ومحكمة لتلافي مشكلة الفترة المسائية ( تسجيل الحضور في يوم ، والخروج في اليوم التالي ) ..

وبما أنك اكتشفت ثغرة ، فاسمح لي باقتراح وملاحظة بسيطين أيضاً ، وهو أنني لاحظت من خلال الدالتين انهما تستخدمان DLookup في كل عملية ما يقارب 7 مرات . ومع وجود حدث التايمر في النموذج .....   

حيث يمكن التعديل بحيث نستخدم استدعاء DLookup تقريباً 3 مرات تقريباً عند كل عملية تسجيل حضور أو انصراف .

تمام

اليك المرفق النهائي بعد معالجة ثغرة توقيع الانصراف من الغد

آمل ان تجري التحسينات المقترحة .. دمت ذخرا لاخوانك ومحبيك

ChkInOut_CNet2.rar

[ابوخليل]

نسيت كلمات المرور للدخول

عام = 1

مدير= 2

[Foksh]

فكرتي في التعديل كالتالي للدالتين :-

Public Function funFirstTimeB_in() As Date
    Dim z As Integer
    Dim fatrahIn As Date
    Dim baseDate As Date
    
    z = Nz(DLookup("free2_in", "tblTimeCtrl"), 0)
    fatrahIn = Nz(DLookup("fatrah2_In", "tblTimeCtrl"), #12:00:00 AM#)
    
    If CheckTimeBetween() = 1 Then
        baseDate = Date
    Else
        baseDate = DateAdd("d", -1, Date)
    End If
    
    funFirstTimeB_in = DateAdd("n", -z, CDate(fatrahIn & " " & baseDate))
End Function

Public Function funLastTimeB_Out() As Date
    Dim z As Integer, x As Integer, xx As Integer
    Dim fatrahIn As Date
    Dim baseDate As Date
    
    z = Nz(DLookup("free2_out", "tblTimeCtrl"), 0)
    x = Nz(DLookup("hours_Work2", "tblTimeCtrl"), 0)
    fatrahIn = Nz(DLookup("fatrah2_In", "tblTimeCtrl"), #12:00:00 AM#)
    
    xx = (x * 60) + z
    
    If CheckTimeBetween() = 1 Then
        baseDate = Date
    Else
        baseDate = DateAdd("d", -1, Date)
    End If
    
    funLastTimeB_Out = DateAdd("n", xx, CDate(fatrahIn & " " & baseDate))
End Function

 

 

ChkInOut_CNet2.zip

[ابوخليل]

57 دقائق مضت, Foksh said:

فكرتي في التعديل كالتالي للدالتين :-

بارك الله فيك .. اجدت وأفدت

المهم هو توقيع فوكش .. جميلة هذه التوقيعات .. تذكرنا ببعض 

في محفوظاتي اعمال كثيرة استفيد منها عند الحاجة فابحث عنها واوظفها

غالب هذه الاعمال لإخوة لنا هنا .. ولكن لا يوجد عليها علامات تذكرنا بهم .. اقل حق من حقوقهم ان ندعو لهم في ظهر الغيب

 

[Debug Ace]

طيب دى الفكرة الاولى 
 

'=== 1. فحص الوردية المسائية  ===
Public Function IsEveningShiftNow() As Boolean
    Dim t As Date: t = Time()
    IsEveningShiftNow = (t >= #12:01:00 PM# And t < #12:00:00 AM#)
End Function

'=== 2. تاريخ الوردية الحالية  ===
Public Function CurrentShiftDate() As Date
    CurrentShiftDate = IIf(IsEveningShiftNow(), Date, Date - 1)
End Function

'=== 3. وقت بداية التسجيل المسموح (قبل الدخول الرسمي) ===
Public Function funFirstTimeB_In() As Date
    Dim officialIn As String, freeMins As Long
    
    officialIn = Nz(DLookup("fatrah2_In", "tblTimeCtrl"), "17:00:00")
    freeMins = Nz(DLookup("free2_in", "tblTimeCtrl"), 30)
    
    funFirstTimeB_In = DateAdd("n", -freeMins, CurrentShiftDate + TimeValue(officialIn))
End Function

'=== 4. وقت نهاية التسجيل المسموح (بعد الانصراف الرسمي) ===
Public Function funLastTimeB_Out() As Date
    Dim officialIn As String
    Dim workHours As Long, extraMins As Long
    
    officialIn = Nz(DLookup("fatrah2_In", "tblTimeCtrl"), "17:00:00")
    workHours = Nz(DLookup("hours_Work2", "tblTimeCtrl"), 8)
    extraMins = Nz(DLookup("free2_out", "tblTimeCtrl"), 30)
    
    funLastTimeB_Out = DateAdd("n", (workHours * 60) + extraMins, _
                               CurrentShiftDate + TimeValue(officialIn))
End Function

ودى فكرة تانية
 

'===============================================================================
' نظام تحديد ورديات الدوام المسائية مع أوقات التسجيل المسموح بها
' وردية مسائية: 17:00 → 01:00 (تمتد بعد منتصف الليل)
'===============================================================================

'=== الثوابت للوردية المسائية ===
Private Const SHIFT_START_HOUR As Integer = 17     ' 5 مساءً
Private Const SHIFT_END_HOUR As Integer = 1        ' 1 صباحًا
Private Const DEFAULT_WORK_HOURS As Long = 8
Private Const DEFAULT_FREE_IN_MINS As Long = 30
Private Const DEFAULT_FREE_OUT_MINS As Long = 30

'=== 1. فحص ما إذا كان الوقت الحالي ضمن وردية مسائية ===
Public Function IsEveningShiftNow() As Boolean
    Dim t As Date: t = Time()
    IsEveningShiftNow = (t >= TimeSerial(SHIFT_START_HOUR, 0, 0)) Or (t < TimeSerial(SHIFT_END_HOUR, 0, 0))
End Function

'=== 2. تاريخ الوردية الحالية (الأصح للورديات المتداخلة) ===
Public Function CurrentShiftDate() As Date
    If IsEveningShiftNow() Then
        ' إذا كان بعد 17:00 اليوم أو قبل 01:00 اليوم التالي
        If Time() >= TimeSerial(SHIFT_START_HOUR, 0, 0) Then
            CurrentShiftDate = Date
        Else
            CurrentShiftDate = Date - 1
        End If
    Else
        CurrentShiftDate = Date
    End If
End Function

'=== 3. قراءة إعدادات الوردية مرة واحدة (تحسين الأداء) ===
Private Function GetShiftSettings() As Variant
    Static cachedSettings As Variant
    Static lastCacheTime As Date
    
    ' تجديد الكاش كل 5 دقائق
    If DateDiff("n", lastCacheTime, Now()) > 5 Then
        Dim rst As DAO.Recordset
        Set rst = CurrentDb.OpenRecordset("SELECT fatrah2_In, hours_Work2, free2_in, free2_out FROM tblTimeCtrl WHERE 1=1")
        
        If Not rst.EOF Then
            cachedSettings = Array( _
                Nz(rst!fatrah2_In, "17:00:00"), _
                Nz(rst!hours_Work2, DEFAULT_WORK_HOURS), _
                Nz(rst!free2_in, DEFAULT_FREE_IN_MINS), _
                Nz(rst!free2_out, DEFAULT_FREE_OUT_MINS) _
            )
        Else
            cachedSettings = Array("17:00:00", DEFAULT_WORK_HOURS, DEFAULT_FREE_IN_MINS, DEFAULT_FREE_OUT_MINS)
        End If
        
        rst.Close: Set rst = Nothing
        lastCacheTime = Now()
    End If
    
    GetShiftSettings = cachedSettings
End Function

'=== 4. وقت بداية التسجيل المسموح (قبل الدخول الرسمي) ===
Public Function funFirstTimeB_In() As Date
    Dim settings As Variant: settings = GetShiftSettings()
    Dim officialIn As Date: officialIn = TimeValue(settings(0))
    Dim freeMins As Long: freeMins = CLng(settings(2))
    
    funFirstTimeB_In = DateAdd("n", -freeMins, CurrentShiftDate + officialIn)
End Function

'=== 5. وقت نهاية التسجيل المسموح (بعد الانصراف الرسمي) ===
Public Function funLastTimeB_Out() As Date
    Dim settings As Variant: settings = GetShiftSettings()
    Dim officialIn As Date: officialIn = TimeValue(settings(0))
    Dim workHours As Long: workHours = CLng(settings(1))
    Dim extraMins As Long: extraMins = CLng(settings(3))
    
    funLastTimeB_Out = DateAdd("n", (workHours * 60) + extraMins, CurrentShiftDate + officialIn)
End Function

'=== 6. وظائف إضافية للتحقق والاختبار ===
Public Function GetCurrentShiftInfo() As String
    Dim shiftDate As Date: shiftDate = CurrentShiftDate()
    GetCurrentShiftInfo = "الوردية: " & Format(shiftDate, "yyyy-mm-dd") & " | " & _
                         "الدخول المسموح: " & Format(funFirstTimeB_In(), "hh:nn") & " | " & _
                         "الخروج المسموح: " & Format(funLastTimeB_Out(), "hh:nn")
End Function

Public Function TestShiftLogic(Optional testTime As Date = 0) As String
    If testTime = 0 Then testTime = Now()
    Dim originalTime As Date: originalTime = Time()
    
    Time = testTime  ' اختبار مؤقت
    
    TestShiftLogic = "الوقت: " & Format(testTime, "hh:nn:ss") & " → " & GetCurrentShiftInfo()
    
    Time = originalTime  ' إعادة الوقت الأصلي
End Function

بصراحة لم اقم باى تجارب خى مجرد تعديلات للاكواد بشكل نظرى تماما وفق فهمى

[Foksh]

18 دقائق مضت, Debug Ace said:

    IsEveningShiftNow = (t >= #12:01:00 PM# And t < #12:00:00 AM#)

🤨

[Debug Ace]

طيب وانا كتبت الفكرة الثانية ليه تفتكر من فراغ يعنى ؟؟؟

 

[Foksh]

24 دقائق مضت, Debug Ace said:

طيب وانا كتبت الفكرة الثانية ليه تفتكر من فراغ يعنى ؟؟؟

 

وهذه الإجابة التي انتظرها لتأكيد رواية "اني لأشم ريح يوسف"  

وأعلم أنها ليست من فراغ 

وارجو ان يتسع صدرك لحديثنا هذا بأن توضح لي المقصود من الدالة 

Public Function TestShiftLogic(Optional testTime As Date = 0) As String
    If testTime = 0 Then testTime = Now()
    Dim originalTime As Date: originalTime = Time()
    
    Time = testTime  ' اختبار مؤقت
    
    TestShiftLogic = "الوقت: " & Format(testTime, "hh:nn:ss") & " → " & GetCurrentShiftInfo()
    
    Time = originalTime  ' إعادة الوقت الأصلي
End Function

 

هل تحاول تغيير وقت النظام ( في الكمبيوتر ) فعلياً بهذه الدالة ؟؟؟؟

[Debug Ace]

4 دقائق مضت, Foksh said:

هل تحاول تغيير وقت النظام ( في الكمبيوتر ) فعلياً بهذه الدالة ؟؟؟؟

الدالة لا تغير وقت النظام الحقيقي في الكمبيوتر 

الدالة محاكاة اختبار لمنطق الورديات بتغيير الوقت الحالي بشكل مؤقت لاختبار سلوك النظام في أوقات مختلفة دون انتظار مرور الوقت الحقيقي

Public Function TestShiftLogic(Optional testTime As Date = 0) As String
    If testTime = 0 Then testTime = Now()           ' 1. استخدم الوقت الحالي لو مفيش وقت محدد
    
    Dim originalTime As Date: originalTime = Time() ' 2. احفظ الوقت الأصلي
    
    Time = testTime                                 ' 3. غير الوقت الحالي بشكل مؤقت ← **السر هنا**
    
    TestShiftLogic = "الوقت: " & Format(testTime, "hh:nn:ss") & " → " & GetCurrentShiftInfo()
                                                ' 4. نفذ الاختبار واحصل على النتيجة
    
    Time = originalTime                             ' 5. ارجع الوقت الأصلي ← **الأمان**
End Function

صارت الامور اوضح معك بهذا الشرح

[Foksh]

2 دقائق مضت, Debug Ace said:

الدالة لا تغير وقت النظام الحقيقي في الكمبيوتر 

الدالة محاكاة اختبار لمنطق الورديات بتغيير الوقت الحالي بشكل مؤقت لاختبار سلوك النظام في أوقات مختلفة دون انتظار مرور الوقت الحقيقي

تمام ، وبما أنك تحاكي اختبار لمنطق الورديات .. فإن اسناد قيمة إلى دالة مدمجة في اكسيس مثل Time بحد ذاته غير منطقي ( وجهة نظري طبعاً ) . وبالتالي فإن الحل الأفضل هو جعل الدوال تستقبل الوقت كـ باراميتر ، أو إنشاء دالة وسيطة تعيد الوقت الحالي .

 

واعتذر إن جررت الحديث خارج محتوى الموضوع