اريد عمل اغلاق اجباري للفورم اذا لم تستخدم من لمدة محددة

[بن شجاع الدين]

شهركم مبارك,

عل يمكن ان اضع شرط في نموذج يقوم باغلاق  اجباري للفورم اذا لم تستخدم من لمدة محددة مثلا (دقيقتان) و ايضا اغلاق اجباري لقاعدة البيانات اذا لم تستخدم لوقت معين مثلا (عشر دقائق).

[أ / محمد صالح]

كل شيء ممكن

بالتفكير والتحليل والتجربة والخطأ

المهم الوصول لفكرة تؤدي الغرض

 

[husamwahab]

تفضل اخي العزيز

ارجو ان يكون فيه طلبك

سيتم اغلاق نموذج(Main) بعد دقيقة ثم بعدها بدقية ثانية سيتم اغلاق قاعدة البيانات

 

asd.rar

[بن شجاع الدين]

شكرا جزيلا اخي حسام ,

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

ولاكن ما اريده هو ان يتم الأقفال النموذج بعد مدة معينة  فقط اذا لم يستخدم  ويبدا العداد مجددا عند عمل اي عملية داخل النموذج و ان يتم الأقفال لقاعدة البيانات بعد مدة معينة  فقط اذا لم تستخدم قاعدة البيانات عموما ويبدا العداد مجددا عند عمل اي عملية داخلها.

[husamwahab]

السلام عليكم اخ بن شجاع

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

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

الخطا بان وضعت نموذج لا يقوم باي حركة

ملاحظة: الكود من شركة مايكروسوفت وهذا هو الرابط

https://support.microsoft.com/en-us/help/210297/how-to-detect-user-idle-time-or-inactivity-in-access-2000

وهذا تعديل للبرنامج السابق

 

asd1.rar

[Shivan Rekany]

استأذن من الجماعة

اليك هذه الطريقة لعل يفيدك

استخدمت هذه الاكواد

    Dim Sewani As Integer
    
Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 1000
End Sub

Private Sub Form_Timer()
    Sewani = Sewani + 1
    Me.Text2 = Sewani
    If Sewani >= 15 Then
            DoCmd.Close acForm, Me.Name
    End If
End Sub

Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Sewani = 0
End Sub

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Sewani = 0
End Sub

Private Sub FormFooter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Sewani = 0
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Sewani = 0
End Sub

 

اغلاق نموذج بعد 15 ثواني.rar

تم تعديل يونيو 5, 2017 بواسطه Shivan Rekany

[husamwahab]

فكرة جميلة اخ شيفان

لكن عيبها انه لايمكن تطبيقها الا في برنامج يحتوي على نموذج واحد فقط

[Shivan Rekany]

الان, husamwahab said:

لكن عيبها انه لايمكن تطبيقها الا في برنامج يحتوي على نموذج واحد فقط

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

[husamwahab]

لو فرضنا ان النموذج الذي يحتوي الكود هو النموذج الرئيسي ومن خلاله يتم فتح نماذج اخرى

بمجرد ان يتم فتح نموذج اخر ويتم العمل عليه لاكثر من 15 ثانية فان النموذج الرئيسي سيغلق

وهو منطقي لان التركيز انتقل لنموذج اخر مما سيجبر العداد في النموذج الرئيسي بالعد وسيقوم بالاغلاق حسب الفترة المحددة وهي 15 ثانية

هذا والله العالم

واعتذر على الاطالة

[Shivan Rekany]

الان, husamwahab said:

بمجرد ان يتم فتح نموذج اخر ويتم العمل عليه لاكثر من 15 ثانية فان النموذج الرئيسي سيغلق

وهو منطقي لان التركيز انتقل لنموذج اخر مما سيجبر العداد في النموذج الرئيسي بالعد وسيقوم بالاغلاق حسب الفترة المحددة وهي 15 ثانية

تقدر تتغير العداد الى صفر بحركة من اي نموذج تريد

القي نظرتا الى المرفق

اكواد نموذج الرئيسي

    
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Me.Text2 = 0
End Sub

Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 1000
    Me.Command6.SetFocus
End Sub

Private Sub Form_Timer()
    Me.Text2 = Me.Text2 + 1
    If Me.Text2 >= 15 Then
            DoCmd.Close acForm, Me.Name
    End If
End Sub

Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Text2 = 0
End Sub

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Text2 = 0
End Sub

Private Sub FormFooter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Text2 = 0
End Sub

وهذه اكواد نموذج الثاني

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If CurrentProject.AllForms("frm1").IsLoaded = True Then
            Forms!frm1!Text2 = 0
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If CurrentProject.AllForms("frm1").IsLoaded = True Then
            Forms!frm1!Text2 = 0
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 1000
End Sub

Private Sub Form_Timer()
    If CurrentProject.AllForms("frm1").IsLoaded = False Then
            DoCmd.Close acForm, Me.Name
    End If

End Sub

واليك المرفق

 

اغلاق نموذج بعد 15 ثواني.rar

تم تعديل يونيو 5, 2017 بواسطه Shivan Rekany

[بن شجاع الدين]

شكرا جزيلا للجميع:

استخدمت هذه الكود وكانت النتائج جيدة.

حيث يوضع هذا الكود في نموذج البداية عند فتح قاعدة البيانات بشرط ان يكون مفتوح دائما " يعني ممكن يكون مخفي"

وكما ترون يعتمد على النموذج الفاعل اي كان ويقوم بمراقبة سجلات محددة ومتابعة التغييرات اذا حدثت .

ايضا يتابع التنقل بين النماذج فاذا لم يحصل التغيير خلال الفترة المحددة  ب15 دقيقة يقوم باقفال قاعدة البيانات.

شكرا لمساعدتكم جميعا

 

 

Private Sub Form_Timer()

         ' IDLEMINUTES determines how much idle time to wait for before
         ' running the IdleTimeDetected subroutine.
         Const IDLEMINUTES = 15

         Static PrevControlName As String
         Static PrevFormName As String
         Static ExpiredTime

         Dim ActiveFormName As String
         Dim ActiveControlName As String
         Dim ExpiredMinutes

         On Error Resume Next

         ' Get the active form and control name.

         ActiveFormName = Screen.ActiveForm.STOLINNO
         'ACTIVRECORD = Screen.ActiveControl.STOLINNO
         If Err Then
            ActiveFormName = "No Active Form"
            Err = 0
         End If

         ActiveControlName = Screen.ActiveControl.ID
      
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
        ActiveControlName = Screen.ActiveControl.SES
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         ActiveControlName = Screen.ActiveControl.Status
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         ActiveControlName = Screen.ActiveControl.Problems And issues4
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
        ActiveControlName = Screen.ActiveControl.Problems And issues2
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.RecordID
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.lng_TblRecord
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.sesreprt1
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.sesreprt2
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.Frame7
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
          ActiveControlName = Screen.ActiveControl.VendorName
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         ActiveControlName = Screen.ActiveControl.Statusselctreport
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         ActiveControlName = Screen.ActiveControl.NONTID
            If Err Then
            ActiveControlName = "No Active Control"
            Err = 0
         End If
         ' Record the current active names and reset ExpiredTime if:
         '    1. They have not been recorded yet (code is running
         '       for the first time).
         '    2. The previous names are different than the current ones
         '       (the user has done something different during the timer
         '        interval).
         If (PrevControlName = "") Or (PrevFormName = "") _
           Or (ActiveFormName <> PrevFormName) _
           Or (ActiveControlName <> PrevControlName) Then
            PrevControlName = ActiveControlName
            PrevFormName = ActiveFormName
            ExpiredTime = 0
         Else
            ' ...otherwise the user was idle during the time interval, so
            ' increment the total expired time.
            ExpiredTime = ExpiredTime + Me.TimerInterval
         End If

         ' Does the total expired time exceed the IDLEMINUTES?
         ExpiredMinutes = (ExpiredTime / 1000) / 60
         If ExpiredMinutes >= IDLEMINUTES Then
            ' ...if so, then reset the expired time to zero...
            ExpiredTime = 0
            ' ...and call the IdleTimeDetected subroutine.
            IdleTimeDetected ExpiredMinutes
         End If
      End Sub

[basher.m]

ممكن ترفق المثال بعد تطبيقك لهذا الكود 
لاني عندي ما اشتغل

وساكون شاكر لك اخي الكريم

[بن شجاع الدين]

تفضل المثال اخي الكريم تم تجهيزة على عجل

CLOSE DB ON TIME.rar