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

اخي الفاضل

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

اتمنى في المرات القادمة عدم تحديد شخص بعينه للاجابة على السؤال لان هذا مخالف لقوانين المنتدى والمشاركة مما يتسبب في حرمان الاخرين من المشاركة او اغلاق المشاركة لهذا تم تعديل عنوان المشاركة من " المشرفة زهره " الى " اغلاق النموذج بعد فتره محدده "

اجابة على سؤالك

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

Option Compare Database
Option Explicit
Dim MyTime As Date

Public Function MyTimer()
If MyTime = Empty Then MyTime = Now()
If Now() >= DateAdd("n", 1, MyTime) Then DoCmd.Close
End Function

ويتم استدعاء هذه الدالة من خلال حدث عند عداد الوقت لأي نموذج

Private Sub Form_Timer()
Call MyTimer
End Sub

او تضع مباشرة عند عداد الوقت هذه العبارة ()MyTimer=

فكلا الطريقتين سوف تستدعي الدالة

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

وهذا الملف بعد التعديل

CLOSE_UP.rar

اختكم

زهره

alsalam 3alaykom
hada code bekhalek tet7akem bel namothej elfate7
7oto bel Module
bas lazem tdef el jomle hay bekol Form

Private Sub Form_Activate()
   ResetEvents ActiveForm
   AddEventsHandlerr Me
End Sub
w etha kan 3ndak Event in the Form like Form_KeyDown or Form_MouseMove
like this [ fel file ana 7at KeyDown Event wa7ad fel code wa7ad fel macro]
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
lazem Change it to
Public Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
3ashan el CallBackProcedure Call it again ba3d ma y3'ayer el time
w etha el Event kan marbot ma3 macro ma fe moshkele el CallBackProcedure Function 
ra7 run el macro

Option Compare Database
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

CLOSE.rar

آسف لم اكن اقصد هذا الخطأ

وشكرا للمساعدة من الجميع

شكرا لك اخي محب الرسول

بصراحة كنت افكر كل المكتوب اكواد

لكن بعد الترجمة من العربي الى العربي

اتضح لي ان كلامك حلو

بس تعبني شوي وذكرني اول نزول للجوالات بدون تعريب

كنا نرسل الرسايل لبعض بنفس الطريقة

اخوك ابو عبدالله

alsalam 3alaykom 
7ayak allah akh ابو عبدالله
sorry 3ashan baktob bel a7rof elenglezeye bass ana basta3mel el labtop hala w ma sa3be aktob 3arabe 3aleh