كيفية إغلاق برنامج في الأكسيس بعد مضي فترة معينة من الزمن

هذا مثال

/index.php?showtopic=230499&st=0&p=1144604&hl=+%C7%DB%E1%C7%DE%20+%C7%E1%E4%E3%E6%D0%CC&fromsearch=1entry1144604

ومثال اخر

/index.php?showtopic=217093&st=0&p=1075079&hl=+%C7%DB%E1%C7%DE%20+%C7%E1%E4%E3%E6%D0%CC&fromsearch=1entry1075079

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

شكرا لك أخي malik2010 علي سرعة الرد

ولكن هذه الأمثلة تعمل في حال كان النموذج الموضوع به الكود مفتوحاً ولكن إذا كان نموذجاً أخر مفتوح فلا يعمل الكود

وكما أوضحت بسؤالي أن البرنامج به العديد من النماذج ولا نستطيع أن نتنبأ على أي من النماذج سوف يتوقف المستخدم عن العمل لكي يتم حساب الوقت المتبقي لإيقاف البرنامج فمثلا في المثال المرفق يمكن أن يتوقف المستخدم عند النموذج الأول أو الخامس أو أي نموذج آخر فكيف سيتم حساب الوقت المتبقي لإيقاف البرنامج ؟

علماً بأن البرنامج الرئيسي به العشرات من النماذج فليس من المعقول أن أضع كود في كل نموذج ولذلك أتمنى أن يكون هناك كود يوضع في وحدة نمطية يتم تطبيقها على جميع نماذج البرنامج بدون إستثناء

ولك مني جزيل الشكر على الإهتمام

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

للرفع .......

أرجو ممن لديه أي فكرة في هذا الموضوع أن يتكرم علينا بها

ولكم منا جزيل الشكر

للرفع

اليك اخى ماتريد

افتح وحدة نمطية و ضع بها هذا الكود

Dim ArrayIntelized As Boolean
Dim EventsArray, OldEventsArray
Dim EventArrayArgs
Public MyTime As Date
Dim objActiveForm As Object
Dim PrevInterval As Long

Const IdleMinuts = 2

Sub IntelizeArray()
    If ArrayIntelized = True Then Exit Sub
    ArrayIntelized = True
    EventsArray = Array("OnTimer", "OnMouseMove", "OnKeyDown", "Detail.OnMouseMove")
    OldEventsArray = Array("", "", "", "")
    EventArrayArgs = Array(0, 4, 2, 4)
End Sub

Public Property Set ActiveForm(ByVal vNForm As Form)
    On Error Resume Next
    If Not ArrayIntelized Then IntelizeArray
    Set objActiveForm = vNForm
End Property

Public Property Get ActiveForm() As Form
    Set ActiveForm = objActiveForm
End Property

Public Sub AddEventsHandlerr(ObjForm As Form)
    On Error Resume Next
    MyTime = Now()
    If ActiveForm Is ObjForm Then Exit Sub

    Set ActiveForm = ObjForm
    Call IntelizeArray
    Dim Obj As Object
    Dim Evt As String

    For i = 0 To UBound(EventsArray)
        Evt = EventsArray(i)
        If InStr(Evt, ".") > 0 Then
           ObjName = Left(Evt, InStr(Evt, ".") - 1)
           Evt = Mid(Evt, InStr(Evt, ".") + 1)
           Set Obj = CallByName(ObjForm, ObjName, VbGet)
        Else
          Set Obj = ObjForm
        End If

        OldEventsArray(i) = CallByName(Obj, Evt, VbGet)
        If IsNumeric(OldEventsArray(i)) Then OldEventsArray(i) = ""
        If LCase(EventsArray(i)) = "ontimer" Then
           PrevInterval = Obj.TimerInterval
           If Obj.TimerInterval = 0 Then ObjForm.TimerInterval = 1000
           CallByName ObjForm, Evt, VbLet, "=TimerLooping()"
        Else
            CallByName Obj, Evt, VbLet, "=CallBackProcedure(" & i & ")"
        End If
    Next
End Sub

Sub ResetEvents(ObjForm As Form)
On Error Resume Next
'    If ActiveForm Is ObjForm Then Exit Sub
    If IsArray(EventsArray) = False Then Call IntelizeArray
    Dim Obj As Object, ObjName As String
    Dim Evt As String
    ObjForm.TimerInterval = PrevInterval
    For i = 0 To UBound(EventsArray)
        Evt = EventsArray(i)
        If InStr(Evt, ".") > 0 Then
           ObjName = Left(Evt, InStr(Evt, ".") - 1)
           Evt = Mid(Evt, InStr(Evt, ".") + 1)
           Set Obj = CallByName(ObjForm, ObjName, VbGet)
        Else
           Set Obj = ObjForm
        End If
        CallByName Obj, Evt, VbLet, CStr(OldEventsArray(i))
    Next
End Sub

Function CallBackProcedure(Index)
     On Error Resume Next
     MyTime = Now()
     Dim PrevProc As String
     PrevProc = OldEventsArray(Index)
     Evt = EventsArray(Index)
     If PrevProc = "[Event Procedure]" Then
        If InStr(Evt, ".") > 0 Then
           ObjName = Left(Evt, InStr(Evt, ".") - 1)
           Evt = Mid(Evt, InStr(Evt, ".") + 1)
        Else
           ObjName = "Form"
        End If
        Set Obj = ActiveForm
        Evt = ObjName & "_" & Mid(Evt, 3)
        Select Case EventArrayArgs(Index)
            Case 1
                CallByName Obj, Evt, VbMethod, 0
            Case 2
                CallByName Obj, Evt, VbMethod, 0, 0
            Case 3
                CallByName Obj, Evt, VbMethod, 0, 0, 0
            Case 4
                CallByName Obj, Evt, VbMethod, 0, 0, 0, 0
            Case 5
                CallByName Obj, Evt, VbMethod, 0, 0, 0, 0, 0
            Case Else
                CallByName Obj, Evt, VbMethod
        End Select
     ElseIf Left(PrevProc, 1) = "=" Then
        Application.Run Mid(OldEventsArray(Index), 1)
     ElseIf Len(PrevProc) > 0 Then
        DoCmd.RunMacro OldEventsArray(Index)
     End If

     If LCase(Evt) = "ondeactivate" Then
         ResetEvents ActiveForm
     End If

End Function


Public Function TimerLooping()
    On Error Resume Next
    Dim DateToCompare As Date
    DateToCompare = DateAdd("n", IdleMinuts, MyTime)
    If Now() >= DateToCompare Then DoCmd.Quit
    If True Then
        Dim M As Integer, S As Integer, lpCaption As String
        S = DateDiff("s", Now, DateToCompare)
        M = Int(S / 60)
        S = S Mod 60
        ActiveForm.Caption = "Time Left = " & Format(M, "00") & ":" & Format(S, "00")
   End If
End Function

و ضع هذا الكود فى النماذج

Private Sub Form_Activate()
       ResetEvents ActiveForm
       AddEventsHandlerr Me
End Sub

لاحظ ان المدة تستطيع التحكم بها من خلال هذا السطر بالوحدة النمطية

Const IdleMinuts = 2

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

شكراً لك أخي أبو يوسف على إهتمامك

وجاري التطبيق على قاعدة البيانات

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

أخي أبو يوسف حاولت تجربة ما تكرمت به ولكنه لم يعمل حيث أنه عند الضغط على المفاتيح لا يعيد العد التلقائي وتحريك الماوس لا يؤثر في الإعادة أيضا إلا إذا حركنا الماوس إلى أسفل النموذج

فضلا أخي أبو يوسف لا أمرا أن تطبق على المثال المرفق في أول المشاركة وإرفاقه مع الرد لكي تعم الفائدة

ولك خالص الشكر والتقدير

للرفع

للرفع