نجوم المشاركات

تفضل استاذ @محمود _ المصري الشرح والمرفق بعد التعديل . MahmoudElmasi.rar

وعليكم السلام وحمه الله اتفضل لعله المطلوب برمجة اكسل (1).xlsm تم تصميم الصوره ب ai برمجة اكسل (1).xlsm

اعرض الملف Clock With Smart Timer هذا الموضوع يعد مهماً وحيوياً لمصممي ومطوري النظم أكثر من المستخدم العادي خاصة عند استخدام حدث Timer مع أي نموذج ويريد مطور النظام فتح محرر الأكواد (VBA) في نفس وقت عرض النماذج هنا تحدث المشكلة الكلاسيكية: المطور لا يستطيع تعديل أي كود لأن التايمر النموذج يعطل التركيز داخل المحرر و يسبب أخطاء بفضل هذه الفكرة الثورية هذا الأمر أصبح من الماضي السحيق فكرة العمل باختصار 1 - عند فتح النموذج يبدأ TimerInterval تلقائياً 2 - إذا تم فتح محرر VBA بأى طريقة كانت يتم إيقاف التايمر فوراً 3 - عند إغلاق المحرر والعودة إلى النماذج يتم تشغيل التايمر من جديد تلقائياً وفوراً 4 - لا حاجة لتمرير اسم النموذج الرئيسي أو اسم عنصر الـ Subform يدوياً 5 - المطلوب فقط هو تمرير اسم عنصر التحكم الذي سيتم عرض الوقت فيه (Label أو TextBox) حسب الحاجة والرغبة مميزات الحل ذكـي : يكتشف النموذج الرئيسي والفرعي تلقائياً متعدد : يعمل مع أكثر من نموذج في نفس الوقت مـــرن : يدعم Label و TextBox كعناصر عرض للوقت آمـــن : إذا تم حذف الوحدة النمطية يتحول تلقائياً إلى Fallback Mode باستخدام دالة الوقت الرئيسية : Now() خفيف : لا يعتمد على Timer إضافي للمراقبة جاهــز : يعمل مع النماذج الرئيسية و الفرعية أو الرئيسية المستقلة أو الرئيسية والفرعية معا ----------------------------------------------------- الوحدة النمطية العامة الاسم المقترح: basClockManager الكود... Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function SetWinEventHook Lib "user32" ( _ ByVal eventMin As Long, _ ByVal eventMax As Long, _ ByVal hmodWinEventProc As LongPtr, _ ByVal pfnWinEventProc As LongPtr, _ ByVal idProcess As Long, _ ByVal idThread As Long, _ ByVal dwFlags As Long) As LongPtr Private Declare PtrSafe Function UnhookWinEvent Lib "user32" ( _ ByVal hWinEventHook As LongPtr) As Long Private Declare PtrSafe Function GetAncestor Lib "user32" ( _ ByVal hwnd As LongPtr, _ ByVal gaFlags As Long) As LongPtr #Else Private Declare Function SetWinEventHook Lib "user32" ( _ ByVal eventMin As Long, _ ByVal eventMax As Long, _ ByVal hmodWinEventProc As Long, _ ByVal pfnWinEventProc As Long, _ ByVal idProcess As Long, _ ByVal idThread As Long, _ ByVal dwFlags As Long) As Long Private Declare Function UnhookWinEvent Lib "user32" ( _ ByVal hWinEventHook As Long) As Long Private Declare Function GetAncestor Lib "user32" ( _ ByVal hwnd As Long, _ ByVal gaFlags As Long) As Long #End If Private Const EVENT_SYSTEM_FOREGROUND As Long = &H3 Private Const WINEVENT_OUTOFCONTEXT As Long = &H0 Private Const GA_ROOT As Long = 2 Private gHook As LongPtr Private gAccessHwnd As LongPtr Private gClocks As Object Private Sub EnsureClockStore() If gClocks Is Nothing Then Set gClocks = CreateObject("Scripting.Dictionary") End If End Sub Private Function MakeClockKey(frm As Access.Form) As String On Error GoTo ErrorHandler Dim vParentForm As Access.Form Dim vControlName As String Set vParentForm = frm.Parent vControlName = GetSubformControlName(vParentForm, frm) If Len(vControlName) > 0 Then MakeClockKey = vParentForm.Name & "|" & vControlName & "|" & frm.Name Exit Function End If ErrorHandler: MakeClockKey = frm.Name End Function Private Function CreateClockState(frm As Access.Form, _ ByVal pControlName As String, _ ByVal pIntervalMS As Long) As Object Dim vState As Object Set vState = CreateObject("Scripting.Dictionary") Dim vIsSubform As Boolean Dim vParentName As String Dim vSubCtlName As String On Error Resume Next vParentName = frm.Parent.Name vSubCtlName = GetSubformControlName(frm.Parent, frm) vIsSubform = (Len(vSubCtlName) > 0) On Error GoTo 0 vState.Add "Key", MakeClockKey(frm) vState.Add "HostFormName", frm.Name vState.Add "ParentFormName", vParentName vState.Add "SubformControlName", vSubCtlName vState.Add "IsSubform", vIsSubform vState.Add "ControlName", pControlName vState.Add "WasStoppedByVBE", False vState.Add "IntervalMS", pIntervalMS Set CreateClockState = vState End Function Public Sub StartSmartClock(frm As Access.Form, _ ByVal pControlName As String, _ Optional ByVal pIntervalMS As Long = 1000) On Error GoTo ErrorHandler EnsureClockStore Dim vKey As String Dim vState As Object vKey = MakeClockKey(frm) If gClocks.Exists(vKey) Then gClocks.Remove vKey Set vState = CreateClockState(frm, pControlName, pIntervalMS) gClocks.Add vKey, vState frm.TimerInterval = pIntervalMS If gAccessHwnd = 0 Then gAccessHwnd = Application.hWndAccessApp If gHook = 0 Then gHook = SetWinEventHook( _ EVENT_SYSTEM_FOREGROUND, _ EVENT_SYSTEM_FOREGROUND, _ 0, _ AddressOf ForegroundChangedProc, _ 0, 0, _ WINEVENT_OUTOFCONTEXT) End If Exit Sub ErrorHandler: End Sub Public Sub StopSmartClock(frm As Access.Form) On Error Resume Next EnsureClockStore Dim vKey As String vKey = MakeClockKey(frm) frm.TimerInterval = 0 If gClocks.Exists(vKey) Then gClocks.Remove vKey End If If gClocks.Count = 0 Then If gHook <> 0 Then UnhookWinEvent gHook gHook = 0 End If Set gClocks = Nothing End If End Sub Public Sub SmartClockTimer(frm As Access.Form) On Error Resume Next EnsureClockStore Dim vKey As String Dim vState As Object vKey = MakeClockKey(frm) If Not gClocks.Exists(vKey) Then Exit Sub Set vState = gClocks(vKey) If IsVbeOpen() Then vState("WasStoppedByVBE") = True frm.TimerInterval = 0 Exit Sub End If Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay frm, vState("ControlName"), vTimeText End If End Sub Private Function IsVbeOpen() As Boolean On Error Resume Next IsVbeOpen = Application.VBE.MainWindow.Visible If Err.Number <> 0 Then IsVbeOpen = False On Error GoTo 0 End Function Private Sub UpdateControlDisplay(frm As Access.Form, ByVal pControlName As String, ByVal pDisplayText As String) On Error Resume Next Dim vControl As Access.Control Set vControl = frm.Controls(pControlName) If vControl Is Nothing Then Exit Sub Select Case vControl.ControlType Case acTextBox If vControl.Value <> pDisplayText Then vControl.Value = pDisplayText End If Case acLabel If vControl.Caption <> pDisplayText Then vControl.Caption = pDisplayText End If End Select End Sub Private Function GetSubformControlName(vParentForm As Access.Form, vChildForm As Access.Form) As String On Error Resume Next Dim vControl As Access.Control For Each vControl In vParentForm.Controls If vControl.ControlType = acSubform Then If vControl.Form Is vChildForm Then GetSubformControlName = vControl.Name Exit Function End If End If Next vControl End Function Private Function GetStateTargetForm(vState As Object, ByRef vForm As Access.Form) As Boolean On Error GoTo ErrorHandler If vState("IsSubform") Then If (SysCmd(acSysCmdGetObjectState, acForm, vState("ParentFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("ParentFormName")).Controls(vState("SubformControlName")).Form Else If (SysCmd(acSysCmdGetObjectState, acForm, vState("HostFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("HostFormName")) End If GetStateTargetForm = Not (vForm Is Nothing) Exit Function ErrorHandler: Set vForm = Nothing End Function #If VBA7 Then Public Sub ForegroundChangedProc( _ ByVal hWinEventHook As LongPtr, _ ByVal eventId As Long, _ ByVal hwnd As LongPtr, _ ByVal idObject As Long, _ ByVal idChild As Long, _ ByVal dwEventThread As Long, _ ByVal dwmsEventTime As Long) #Else Public Sub ForegroundChangedProc( _ ByVal hWinEventHook As Long, _ ByVal eventId As Long, _ ByVal hwnd As Long, _ ByVal idObject As Long, _ ByVal idChild As Long, _ ByVal dwEventThread As Long, _ ByVal dwmsEventTime As Long) #End If On Error Resume Next If gClocks Is Nothing Then Exit Sub If gClocks.Count = 0 Then Exit Sub If GetAncestor(hwnd, GA_ROOT) <> gAccessHwnd Then Exit Sub Dim vKey As Variant Dim vState As Object Dim vForm As Access.Form For Each vKey In gClocks.Keys Set vState = gClocks(vKey) If vState("WasStoppedByVBE") Then If GetStateTargetForm(vState, vForm) Then vForm.TimerInterval = vState("IntervalMS") Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay vForm, vState("ControlName"), vTimeText End If vState("WasStoppedByVBE") = False End If End If Next vKey End Sub ----------------------------------------------------- طريقة الاستدعاء في النماذج نموذج يعرض الوقت في Label الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "lblTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج يعرض الوقت في TextBox الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "txtTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج بدون عرض نصي للوقت الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- كما تلاحظون الاستدعاء سهل وموحد سواء أردنا عرض الوقت في TextBox أو Label Application.Run "StartSmartClock", Me, "", 1000 ملاحظة هامة حول معامل : TimerInterval وهو المعامل الثالث فى الاستدعاء (Interval) الرقم: 1000 هو قيمة TimerInterval يمثل الفاصل الزمني بالميلي ثانية القيمة الافتراضية : 1000 (ثانية واحدة) تم ضبطها مسبقاً داخل الوحدة النمطية هل هو إجباري؟ لايمكن حذفه والاعتماد على القيمة الافتراضية طرق الاستدعاء المختلفة مع المعامل : ' الطريقة الأولى: تمرير قيمة مخصصة (مثلاً نصف ثانية) Application.Run "StartSmartClock", Me, "lblTime", 500 ' الطريقة الثانية: حذف المعامل (يتم استخدام 1000 تلقائياً) Application.Run "StartSmartClock", Me, "lblTime" في بعض الحالات قد يرغب المصمم في عمل التالى : ساعة عادية لذلك سوف تكون قيمة : TimerInterval =1000 (ثانية واحدة) ساعة دقيقة (Stopwatch) تكون قيمة TimerInterval = 100 (جزء من الثانية) ساعة بطيئة (تحديث نادر) تكون قيمة TimerInterval = 5000 (5 ثوانٍ) لهذا السبب تم جعل هذا المعامل اختيارياً مع استخدام القيمة الإفتراضية المنطقية مع إتاحة المجال للمصمم لتغييره حسب احتياجاته ----------------------------------------------------- نموذج مع Fallback ( منتهى الأمان ) الكود... Option Compare Database Option Explicit Private mIsSmartClockActive As Boolean Private Sub Form_Load() AttemptStartSmartClock End Sub Private Sub Form_Timer() Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If mIsSmartClockActive Then Application.Run "SmartClockTimer", Me Me.txtDClock = vTimeText Else ' Fallback: النموذج يحدث نفسه بنفسه Me.txtDClock = vTimeText Me.lblDClock.Caption = vTimeText End If End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If mIsSmartClockActive Then Application.Run "StopSmartClock", Me End If Me.TimerInterval = 0 On Error GoTo 0 End Sub Private Sub AttemptStartSmartClock() On Error GoTo FallbackMode Application.Run "StartSmartClock", Me, "lblDClock", 1000 mIsSmartClockActive = True Exit Sub FallbackMode: Err.Clear mIsSmartClockActive = False Me.TimerInterval = 1000 End Sub ----------------------------------------------------- الخلاصة النهائية :الاستدعاء المناسب عرض الوقت في : Label LabelStartSmartClock Me, "lblTime" عرض الوقت في : TextBox StartSmartClock Me, "txtTime" بدون عرض نصى للوقت مثلا : ساعة عقارب (بدون عرض نصي) StartSmartClock Me, "" نموذج فرعي (Subform) نفس الكود - يتم اكتشافه تلقائياً نماذج متعددة في نفس الوقت مدعوم بالكامل ملاحظات مهمة إعدادات الأمان : يجب تفعيل Trust access to the VBA project object model في إعدادات Trust Center إصدار Access : يعمل مع Access 2007 والإصدارات الأحدث مراجع إضافية : لا يحتاج إلى إضافة أي مراجع Fallback Mode : إذا تم حذف الوحدة النمطية، يتحول النموذج تلقائياً إلى استخدام Now() مع هذا الحل الفريد أصبح : التحكم في TimerInterval أثناء فتح محرر VBA أمراً تلقائياً بالكامل، دون أي تدخل يدوي أو تعقيدات سهولة فتح محرر VBA و إضافة أو تعديل أى أكواد في نفس وقت عرض النماذج وبدون أن تحدث المشكلة الكلاسيكية بسبب : TimerInterval استمتع بتجربة تطوير سلسة وخالية من المشاكل صاحب الملف ابو جودي تمت الاضافه 04/15/26 الاقسام قسم الأكسيس  

عاجز عن الشكر🙏

بالنسبة للعملة والتلوين تم عمل اللازم أما ملئ معلومات السيارة لابد من نموذجه وانت بتسدعي المعلومات بنموذج الاستمارة بمجرد اختيار رقم السيارة هذا شغل أكسسس وليس أكسل في فرق كبير كما وضحت لك من قبل بين شغل اكسس وشغل اكسل اطبع التقرير بتحصلهم بورقة واحدة ................... انا عملت لك عمل اكسس احترافي وتفضل التعديل ...........ووافني بالرد. Ahmed ElShahat 1.rar

جرب الان ربط 2 كومب بوكس بداخل اتنين نموذج فرعي2.mdb

السلام عليكم في هذا الرابط مرفق لتكبير الصورة ، والمثال المرفق من الرابط . مثال:

الله الله علي الحاجات الحلوه كل يوم جديد عندك الا جودي تحياتي

رائع 👏

وعليكم السلام ورحمة الله وبركاته.. الأستاذ الفاضل، أتقدم إليك بخالص الشكر والتقدير على هذا التصميم الرائع والمجهود الكبير الذي بذلته في إعداد البرنامج. لقد لمستُ في عملك دقة واحترافية عالية، خاصة في تنسيق الواجهة وتوزيع العناصر بشكل يسهل عملية الإدخال. إبداعك في التصميم أعطى للبرنامج روحاً جديدة، وأنا ممتن جداً لوقتك الذي خصصته لمساعدتي وللمساتك الفنية التي جعلت العمل يظهر بهذا المظهر اللائق. بارك الله فيك وفي قلمك وعلمك، وجعل هذا العمل في ميزان حسناتك. لك مني كل الاحترام والتقدير والمودة.

تفضل استاذ @أحمد الشحات85 الشرح والمرفق حسب ما فهمت . ووافني بالرد . Ahmed ElShahat.rar

نموذج مثلا باسم : frmPasswordPrompt العناصر داخل النموذج كالتالى مربع نص باسم : txtPassword زر امر للتأكيد باسم : btnOK زر امر للالغاء والاحباط باسم : btnCancel واستخدم الاكواد التالية فى هذا النموذج Private Sub Form_Load() Me.KeyPreview = True Me.txtPassword.Value = "" Me.txtPassword.SetFocus End Sub Private Sub btnOK_Click() PasswordConfirm Nz(Me.txtPassword.Value, "") DoCmd.Close acForm, Me.Name End Sub Private Sub btnCancel_Click() PasswordCancel DoCmd.Close acForm, Me.Name End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then KeyCode = 0 btnCancel_Click End If End Sub قم بانشاء وحدة نمطية عامة اعطها مثلا اسم : basPasswordPrompt الاكواد داخل الوحدة النمطية تكون كالتالى : Option Compare Database Option Explicit Public Enum PasswordStatus psEmpty = 0 psInvalid = 1 psCancelled = 2 psMaxAttemptsExceeded = 3 psUnsupportedAction = 4 psDangerousSQL = 5 End Enum Public Enum ActionType atOpenForm = 0 atOpenQuery = 1 atOpenReport = 2 atPrintReport = 3 atDeleteAllRecords = 4 atExecuteSQL = 5 atRunGlobalFunction = 6 atRunFormMethod = 7 End Enum Private Const MAX_PASSWORD_ATTEMPTS As Long = 3 Private m_PasswordValue As String Private m_PasswordConfirmed As Boolean Private m_PasswordCancelled As Boolean Public Sub ExecuteAction( _ ByVal actionToExecute As ActionType, _ ByVal targetName As String, _ Optional ByVal expectedPassword As String = "", _ Optional ByVal callerForm As Access.Form = Nothing) On Error GoTo ErrorHandler If Len(Trim$(targetName)) = 0 Then Exit Sub Dim i As Long For i = 1 To MAX_PASSWORD_ATTEMPTS PromptPasswordForm If m_PasswordCancelled Then ShowMessage psCancelled Exit Sub End If If Len(m_PasswordValue) = 0 Then ShowMessage psEmpty GoTo NextTry End If If StrComp(m_PasswordValue, expectedPassword, vbBinaryCompare) <> 0 Then ShowMessage psInvalid GoTo NextTry End If ExecuteInternal actionToExecute, targetName, callerForm m_PasswordValue = "" Exit Sub NextTry: Next i ShowMessage psMaxAttemptsExceeded Exit Sub ErrorHandler: DoCmd.SetWarnings True m_PasswordValue = "" MsgBox Err.Number & " - " & Err.Description, vbCritical Debug.Print "ExecuteAction Error " & Err.Number & ": " & Err.Description End Sub Private Sub ExecuteInternal( _ ByVal actionToExecute As ActionType, _ ByVal targetName As String, _ ByVal callerForm As Access.Form) On Error GoTo ErrorHandler Select Case actionToExecute Case atOpenForm DoCmd.OpenForm targetName Case atOpenQuery DoCmd.OpenQuery targetName Case atOpenReport DoCmd.OpenReport targetName, acViewNormal Case atPrintReport DoCmd.OpenReport targetName, acViewNormal Case atDeleteAllRecords If MsgBox("هل أنت متأكد من حذف جميع السجلات؟", _ vbYesNo + vbCritical + vbDefaultButton2) <> vbYes Then Exit Sub End If SafeRunSQL "DELETE FROM [" & targetName & "]" Case atExecuteSQL If IsDangerousSQL(targetName) Then ShowMessage psDangerousSQL Exit Sub End If SafeRunSQL targetName Case atRunGlobalFunction Application.Run targetName Case atRunFormMethod If callerForm Is Nothing Then Exit Sub On Error Resume Next CallByName callerForm, targetName, VbMethod If Err.Number <> 0 Then MsgBox "Method '" & targetName & "' not found in form.", vbCritical Debug.Print "CallByName Error: " & Err.Description Err.Clear End If On Error GoTo ErrorHandler Case Else ShowMessage psUnsupportedAction End Select Exit Sub ErrorHandler: DoCmd.SetWarnings True MsgBox Err.Number & " - " & Err.Description, vbCritical Debug.Print "ExecuteInternal Error " & Err.Number & ": " & Err.Description End Sub Private Sub SafeRunSQL(ByVal sqlText As String) On Error GoTo ErrorHandler DoCmd.SetWarnings False DoCmd.RunSQL sqlText DoCmd.SetWarnings True Exit Sub ErrorHandler: DoCmd.SetWarnings True MsgBox "SQL Error " & Err.Number & vbCrLf & Err.Description, vbCritical Debug.Print "SafeRunSQL Error " & Err.Number & ": " & Err.Description End Sub Private Function IsDangerousSQL(ByVal sqlText As String) As Boolean Dim t As String t = Trim$(LCase$(sqlText)) If InStr(t, "drop ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "alter ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "create ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "truncate ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "--") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "/*") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "*/") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, ";") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "delete ") > 0 And InStr(t, "where") = 0 Then IsDangerousSQL = True: Exit Function End If If InStr(t, "update ") > 0 And InStr(t, "where") = 0 Then IsDangerousSQL = True: Exit Function End If IsDangerousSQL = False End Function Public Sub PromptPasswordForm() m_PasswordValue = "" m_PasswordConfirmed = False m_PasswordCancelled = False DoCmd.OpenForm "frmPasswordPrompt", WindowMode:=acDialog End Sub Public Sub PasswordConfirm(ByVal passwordValue As String) m_PasswordValue = passwordValue m_PasswordConfirmed = True m_PasswordCancelled = False End Sub Public Sub PasswordCancel() m_PasswordValue = "" m_PasswordConfirmed = False m_PasswordCancelled = True End Sub Public Function GetLastPassword() As String GetLastPassword = m_PasswordValue End Function Public Function WasPasswordCancelled() As Boolean WasPasswordCancelled = m_PasswordCancelled End Function Public Sub ShowMessage(ByVal status As PasswordStatus) Dim sMsg As String Dim nIcon As Long Select Case status Case psEmpty sMsg = "الرجاء إدخال كلمة السر للمتابعة" nIcon = vbExclamation Case psInvalid sMsg = "كلمة سر خاطئة. حاول مرة أخرى" nIcon = vbCritical Case psCancelled sMsg = "تم إلغاء الإجراء" nIcon = vbInformation Case psMaxAttemptsExceeded sMsg = "تم تجاوز عدد المحاولات المسموح بها" nIcon = vbCritical Case psUnsupportedAction sMsg = "إجراء غير مدعوم" nIcon = vbExclamation Case psDangerousSQL sMsg = "تم رفض تنفيذ SQL لأسباب أمنية" nIcon = vbCritical End Select MsgBox sMsg, nIcon + vbMsgBoxRight, "مطالبة كلمة السر" End Sub '======================================================== ' امثلة الاستدعاء والاستخدام '======================================================== ' 1) فتح نموذج ' ExecuteAction atOpenForm, "FormName", "1234" ' ' 2) فتح استعلام ' ExecuteAction atOpenQuery, "QueryName", "1234" ' ' 3) فتح تقرير ' ExecuteAction atOpenReport, "ReportName", "1234" ' ' 4) طباعة تقرير ' ExecuteAction atPrintReport, "ReportName", "1234" ' ' 5) حذف سجلات ' ExecuteAction atDeleteAllRecords, "TableName", "1234" ' ' 6) تنفيذ SQL ' ExecuteAction atExecuteSQL, "UPDATE Table SET Field=1 WHERE ID=5", "1234" ' ' 7) استدعاء دالة عامة ' ExecuteAction atRunGlobalFunction, "MyFunction", "1234" ' ' 8) استدعاء دالة من النموذج الحالي ' ExecuteAction atRunFormMethod, "MyMethod", "1234", Me ' ' 9) فتح نموذج حسب كلمة المرور — في النموذج: ' Private Sub Command0_Click() ' ' Dim sPass As String ' Dim i As Long ' Const MAX_TRIES As Long = 3 ' ' For i = 1 To MAX_TRIES ' ' PromptPasswordForm ' sPass = GetLastPassword() ' ' If WasPasswordCancelled() Then ' MsgBox "تم إلغاء الإجراء", vbInformation + vbMsgBoxRight, "مطالبة كلمة السر" ' Exit Sub ' End If ' ' If Len(sPass) = 0 Then ' MsgBox "الرجاء إدخال كلمة السر للمتابعة", vbExclamation + vbMsgBoxRight, "مطالبة كلمة السر" ' GoTo NextTry ' End If ' ' Select Case sPass ' Case "123": DoCmd.OpenForm "Form1": Exit Sub ' Case "456": DoCmd.OpenForm "Form2": Exit Sub ' Case "789": DoCmd.OpenForm "Form3": Exit Sub ' Case Else ' MsgBox "كلمة سر خاطئة. حاول مرة أخرى", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" ' End Select ' 'NextTry: ' Next i ' ' MsgBox "تم تجاوز عدد المحاولات المسموح بها", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" 'End Sub '======================================================== وتستطيع استخدام اى شئ بتمرير و بتطبيق كلمة مرور اولا من خلال احد الاستدعاءات التالية ' 1) فتح نموذج طبعا مع تغيير : FormName باسم النموذج الذى تريد فتحه ExecuteAction atOpenForm, "FormName", "YourPassword" ' 2) فتح استعلام طبعا مع تغيير : QueryName باسم الاستعلام الذى تريد فتحه ExecuteAction atOpenQuery, "QueryName", "YourPassword" ' 3) فتح تقرير طبعا مع تغيير : ReportName باسم التقرير الذى تريد فتحه ExecuteAction atOpenReport, "ReportName", "YourPassword" ' 4) طباعة تقرير طبعا مع تغيير : ReportName باسم التقرير الذى تريد طباعته ExecuteAction atPrintReport, "ReportName", "YourPassword" ' 5) حذف سجلات طبعا مع تغيير : TableName باسم الجدول الذى تريد حذف سجلاته ExecuteAction atDeleteAllRecords, "TableName", "YourPassword" ' 6) تنفيذ SQL اكتبالجملة حسب تصميمك Dim SQLStatement As String SQLStatement = "UPDATE tblSettings SET IsActive=1 WHERE ID=" & Me.txtID.Value ExecuteAction atExecuteSQL, SQLStatement, "1234" ' 7) استدعاء دالة عامة من اى وحدة نمطية عامة ExecuteAction atRunGlobalFunction, "FunctionName", "YourPassword" ' 8) استدعاء أى وظيفة أو إجراء داخل النموذج الحالى ExecuteAction atRunFormMethod, "MethodName", "YourPassword", Me طبعا تغير كلم : YourPassword بكلمة المرور التى تريدها وكلمة المرور ليست ثابتة تستطيع تغييرها دائما مع الاستدعاءات المختلفة على سبيل المثال لو اردت فتح كل نموذج ولكل نموذج كلمة مرور خاصة به هو ExecuteAction atOpenForm, "frmA", "000" ExecuteAction atOpenForm, "frmB", "111" ExecuteAction atOpenForm, "frmC", "222" وأخيرا لو اردت فتح احد النماذج المتعددة ولكن كل نموذج حسب تمرير كلمة مرور خاصة به استخدم الكود التالى Private Sub Command0_Click() Dim sPass As String Dim i As Long Const MAX_TRIES As Long = 3 For i = 1 To MAX_TRIES PromptPasswordForm sPass = GetLastPassword() If WasPasswordCancelled() Then MsgBox "تم إلغاء الإجراء", vbInformation + vbMsgBoxRight, "مطالبة كلمة السر" Exit Sub End If If Len(sPass) = 0 Then MsgBox "الرجاء إدخال كلمة السر للمتابعة", vbExclamation + vbMsgBoxRight, "مطالبة كلمة السر" GoTo NextTry End If Select Case sPass Case "123": DoCmd.OpenForm "Form1": Exit Sub Case "456": DoCmd.OpenForm "Form2": Exit Sub Case "789": DoCmd.OpenForm "Form3": Exit Sub Case Else MsgBox "كلمة سر خاطئة. حاول مرة أخرى", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" End Select NextTry: Next i MsgBox "تم تجاوز عدد المحاولات المسموح بها", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" End Sub فعندما يتم فتح نموذج المطالبة بكلمة مرور لو تم استخدام كلمة المرور : 123 يتم فتح النموذج : Form1 لو تم استخدام كلمة المرور : 456 يتم فتح النموذج : Form2 لو تم استخدام كلمة المرور : 789 يتم فتح النموذج : Form3 بديل InputBox.accdb