البحث في الموقع

هل تبحثون عن طريقة مرنة وقوية للتحكم في فتح وإغلاق النماذج في قواعد البيانات ؟ إليكم دالة NavigateForm الحل الأمثل لتبسيط إدارة فتح وإغلاق النماذج أو التبديل بين الفتح/والإغلاق بكفاءة عالية! ما هي دالة NavigateForm ؟ NavigateForm هي دالة تستخدم في وحدة نمطية عامة (Module) لإدارة النماذج بطريقة احترافية تقوم الدالة بـالآتي : إغلاق النموذج الحالي أو نموذج محدد فتح نموذج آخر بوضع عرض محدد (مثل العرض العادي - الحوار - التصميم - المخفي - . . . .. إلخ) التبديل بإغلاق نموذج وفتح أخر أو فتح نموذج أخر مع الابقاء على النموذج الأب مفتوح تطبيق فلاتر عبر WhereCondition لتحديد السجلات المعروضة تمرير بيانات إضافية عبر OpenArgs لتخصيص سلوك النموذج الدالة مثالية للمطورين اللي عايزين تنقل سلس بين النماذج مع تحكم دقيق في أوضاع الفتح والإغلاق سواء في تطبيقات بسيطة أو معقدة مميزات دالة NavigateForm مرونة عالية: تدعم إغلاق النموذج الحالي أو إغلاق نموذج محدد أو فتح نموذج بوضع معين أو الجمع بين العمليات دي في استدعاء واحد تعداد مخصص (FormOpenMode): يشمل كل أوضاع فتح النماذج الشائعة: - DefaultMode: الوضع الافتراضي - NormalMode: العرض العادي (Form View) - DesignMode: وضع التصميم (Design View) - DatasheetMode: عرض ورقة البيانات (Datasheet View) - PreviewMode: معاينة الطباعة (Print Preview) - LayoutMode: عرض التخطيط (Layout View) - AddMode: إضافة سجل جديد - EditMode: تعديل السجلات - ReadOnlyMode: القراءة فقط - HiddenMode: فتح النموذج في الوضع المخفي - DialogMode: فتح النموذج كحوار (يوقف تنفيذ الكود حتى الإغلاق) معالجة الأخطاء: تتضمن معالجة أخطاء مدمجة للتعامل مع حالات زي: - أسماء نماذج غير موجودة - محاولة إغلاق نموذج غير مفتوح - أخطاء تشغيل غير متوقعة التعامل مع الإغلاق اليدوي: الدالة بتتعامل بذكاء مع إغلاق النماذج يدويًا (مثل ضغط "X" في النافذة) وبتضمن إمكانية إعادة فتح النموذج بدون مشاكل منع الاستدعاءات المتكررة: بتمنع فتح النموذج مرتين بنفس المعاملات لو كان مفتوح بالفعل، مع إعادة تعيين السجل بعد كل عملية توثيق احترافي: الكود مرفق بتوثيق مفصل يشرح المعاملات و الأوضاع و وأمثلة الاستدعاء سهولة التكامل: يمكن استدعاؤها من أحداث النماذج (مثل أزرار OnClick) أو ماكرو أو كود VBA آخر دعم الفلاتر والبيانات الإضافية: بتسمح بتطبيق فلاتر عبر WhereCondition وتمرير بيانات مخصصة عبر OpenArgs الكود الكود متاح في وحدة نمطية عامة (basNavigateForm)، ويتضمن: تعداد FormOpenMode لتحديد أوضاع الفتح دالة IsFormPresent للتحقق من وجود النموذج دالة NavigateForm لإدارة فتح وإغلاق النماذج Option Compare Database Option Explicit ' متغير عام للتحكم في طباعة رسائل التصحيح Public DebugPrintEnabled As Boolean ' تعداد لتحديد أوضاع فتح النموذج Public Enum FormOpenMode DefaultMode = 0 ' الوضع الافتراضي (يفتح النموذج بإعدادات Access الافتراضية) NormalMode = 1 ' العرض العادي (Form View) DesignMode = 2 ' وضع التصميم (Design View) DatasheetMode = 3 ' عرض ورقة البيانات (Datasheet View) PreviewMode = 4 ' عرض معاينة الطباعة (Print Preview) LayoutMode = 5 ' عرض التخطيط (Layout View) AddMode = 6 ' وضع إضافة سجل جديد EditMode = 7 ' وضع تعديل السجلات ReadOnlyMode = 8 ' وضع القراءة فقط HiddenMode = 9 ' الوضع المخفي (Hidden) DialogMode = 10 ' وضع الحوار (Dialog) End Enum ' ======================================================================= ' الدالة: التحقق من وجود نموذج في قاعدة البيانات ' الوصف: ترجع True إذا كان النموذج موجودًا في قاعدة البيانات، وFalse إذا لم يكن موجودًا ' المعاملات: formName (String) - اسم النموذج المراد التحقق منه ' ' المؤلف: [ابو جودي - منتديات أوفيسنا] ' تاريخ الإنشاء: 24 مايو 2025 ' الإصدار: 2.1 ' ======================================================================= Public Function IsFormPresent(formName As String) As Boolean On Error Resume Next Dim formObj As Object Set formObj = CurrentProject.AllForms(formName) IsFormPresent = Not (formObj Is Nothing) ' طباعة نتيجة التحقق إذا كانت الطباعة مفعلة If DebugPrintEnabled Then Debug.Print "IsFormPresent: التحقق من النموذج '" & formName & "': " & IsFormPresent End If Set formObj = Nothing On Error GoTo 0 End Function ' ======================================================================= ' NavigateForm ' ' وصف: ' دالة عامة للتحكم في فتح وإغلاق نماذج Microsoft Access. تتيح إغلاق ' النموذج الحالي أو نموذج محدد، وفتح نموذج آخر بوضع محدد مع إمكانية ' تمرير بيانات إضافية عبر OpenArgs وتطبيق فلتر عبر WhereCondition. ' إذا كان النموذج المراد فتحه مفتوحًا بالفعل، يتم إغلاقه وإعادة فتحه ' بالوضع المحدد مع الحفاظ على OpenArgs وWhereCondition. ' ' المعاملات: ' - formToClose (اختياري، String): اسم النموذج المراد إغلاقه. ' - formToOpen (اختياري، String): اسم النموذج المراد فتحه. ' - openMode (اختياري، FormOpenMode): وضع فتح النموذج. ' - openArgs (اختياري، Variant): بيانات إضافية لتمريرها إلى النموذج المفتوح. ' - WhereCondition (اختياري، String): شرط فلترة لتحديد السجلات المعروضة. ' ' القيمة المرجعة: ' - Boolean: True إذا نجحت العملية، False إذا حدث خطأ. ' ' أمثلة: ' Call NavigateForm ' إغلاق النموذج الحالي ' Call NavigateForm("Form1") ' إغلاق Form1 ' Call NavigateForm("", "Form2", DialogMode) ' فتح Form2 كحوار ' Call NavigateForm("Form1", "Form2", AddMode) ' إغلاق Form1 وفتح Form2 لإضافة سجل ' Call NavigateForm("", "Form2", NormalMode, "CustomerID=123", "ID=123") ' فتح Form2 مع فلتر ' Call NavigateForm("Form1", "Form2", DialogMode, "Source=MainForm") ' إغلاق Form1 وفتح Form2 كحوار ' Call NavigateForm("", "Form1", DialogMode, , "ID=456") ' إغلاق Form1 وإعادة فتحه كحوار مع فلتر ' ' ملاحظات: ' - تأكد من وجود النماذج المحددة في قاعدة البيانات. ' - وضع DialogMode يوقف تنفيذ الكود حتى إغلاق النموذج. ' - وضع DesignMode قد يكون مقيدًا في قواعد البيانات المحمية. ' - استخدم المتغير العام DebugPrintEnabled لتفعيل طباعة رسائل التصحيح أثناء التجربة. ' - OpenArgs يمكن استخدامه في حدث OnLoad أو OnActivate للنموذج لمعالجة البيانات الممررة. ' - يمكن استدعاء الدالة من ماكرو باستخدام RunCode: NavigateForm() ' - إذا كان النموذج مفتوحًا، سيتم إغلاقه وإعادة فتحه بالوضع المحدد. ' - WhereCondition يتم تطبيقه عند فتح النموذج. ' - يتم منع الاستدعاءات المتكررة بنفس المعاملات فقط إذا كان النموذج مفتوحًا. ' - يتم إعادة تعيين سجل الاستدعاء بعد نجاح أو فشل العملية. ' ' المؤلف: [ابو جودي - منتديات أوفيسنا] ' تاريخ الإنشاء: 24 مايو 2025 ' الإصدار: 2.1 ' ======================================================================= Public Function NavigateForm(Optional ByVal formToClose As String = "", _ Optional ByVal formToOpen As String = "", _ Optional ByVal openMode As FormOpenMode = DefaultMode, _ Optional ByVal openArgs As Variant = Null, _ Optional ByVal WhereCondition As String = "") As Boolean On Error GoTo ErrHandler ' متغير ثابت لتتبع آخر استدعاء Static lastCall As String Dim currentCall As String currentCall = formToClose & "|" & formToOpen & "|" & openMode & "|" & IIf(IsNull(openArgs), "Null", openArgs) & "|" & WhereCondition ' التحقق من التكرار: نتجاهل فقط إذا كان النموذج مفتوحًا ونفس المعاملات If currentCall = lastCall And formToOpen <> "" Then If IsFormPresent(formToOpen) And CurrentProject.AllForms(formToOpen).IsLoaded Then If DebugPrintEnabled Then Debug.Print "NavigateForm: تجاهل استدعاء متكرر بنفس المعاملات: " & currentCall End If NavigateForm = True Exit Function End If End If ' تحديث lastCall lastCall = currentCall ' افتراض النجاح NavigateForm = True ' طباعة المعاملات عند دخول الدالة If DebugPrintEnabled Then Debug.Print "NavigateForm: استدعاء الدالة مع المعاملات - formToClose: '" & formToClose & "', formToOpen: '" & formToOpen & "', openMode: " & openMode & ", openArgs: " & IIf(IsNull(openArgs), "Null", openArgs) & ", WhereCondition: '" & WhereCondition & "'" End If ' إذا لم يتم تمرير أي معاملات، أغلق النموذج الحالي If formToClose = "" And formToOpen = "" Then If Not Screen.ActiveForm Is Nothing Then If DebugPrintEnabled Then Debug.Print "NavigateForm: إغلاق النموذج الحالي '" & Screen.ActiveForm.Name & "'" End If DoCmd.Close acForm, Screen.ActiveForm.Name, acSaveNo ' إعادة تعيين lastCall بعد الإغلاق lastCall = "" Else If DebugPrintEnabled Then Debug.Print "NavigateForm: لا يوجد نموذج حالي مفتوح" End If End If Exit Function End If ' التحقق إذا تم تمرير اسم نموذج للإغلاق If formToClose <> "" Then If IsFormPresent(formToClose) Then If CurrentProject.AllForms(formToClose).IsLoaded Then If DebugPrintEnabled Then Debug.Print "NavigateForm: إغلاق النموذج '" & formToClose & "'" End If DoCmd.Close acForm, formToClose, acSaveNo ' إعادة تعيين lastCall بعد الإغلاق lastCall = "" Else If DebugPrintEnabled Then Debug.Print "NavigateForm: النموذج '" & formToClose & "' غير مفتوح" End If End If Else If DebugPrintEnabled Then Debug.Print "NavigateForm: النموذج '" & formToClose & "' غير موجود" End If MsgBox "النموذج '" & formToClose & "' غير موجود في قاعدة البيانات.", vbExclamation, "خطأ" NavigateForm = False ' إعادة تعيين lastCall بعد الفشل lastCall = "" Exit Function End If End If ' التحقق إذا تم تمرير اسم نموذج للفتح If formToOpen <> "" Then If IsFormPresent(formToOpen) Then ' إذا كان النموذج مفتوحًا بالفعل، أغلقه If CurrentProject.AllForms(formToOpen).IsLoaded Then If DebugPrintEnabled Then Debug.Print "NavigateForm: النموذج '" & formToOpen & "' مفتوح بالفعل، سيتم إغلاقه" End If DoCmd.Close acForm, formToOpen, acSaveNo End If ' فتح النموذج بالوضع المحدد If DebugPrintEnabled Then Debug.Print "NavigateForm: فتح النموذج '" & formToOpen & "' بوضع " & openMode & IIf(IsNull(openArgs), "", ", openArgs: " & openArgs) & IIf(WhereCondition = "", "", ", WhereCondition: " & WhereCondition) End If Select Case openMode Case NormalMode DoCmd.OpenForm formToOpen, acNormal, , WhereCondition, , , openArgs Case DesignMode DoCmd.OpenForm formToOpen, acDesign, , WhereCondition, , , openArgs Case DatasheetMode DoCmd.OpenForm formToOpen, acFormDS, , WhereCondition, , , openArgs Case PreviewMode DoCmd.OpenForm formToOpen, acPreview, , WhereCondition, , , openArgs Case LayoutMode DoCmd.OpenForm formToOpen, acLayout, , WhereCondition, , , openArgs Case AddMode DoCmd.OpenForm formToOpen, acNormal, , WhereCondition, acFormAdd, , openArgs Case EditMode DoCmd.OpenForm formToOpen, acNormal, , WhereCondition, acFormEdit, , openArgs Case ReadOnlyMode DoCmd.OpenForm formToOpen, acNormal, , WhereCondition, acFormReadOnly, , openArgs Case HiddenMode DoCmd.OpenForm formToOpen, acNormal, , WhereCondition, , acHidden, openArgs Case DialogMode DoCmd.OpenForm formToOpen, , , WhereCondition, , acDialog, openArgs Case Else DoCmd.OpenForm formToOpen, , , WhereCondition, , , openArgs End Select ' إعادة تعيين lastCall بعد فتح النموذج lastCall = "" Else If DebugPrintEnabled Then Debug.Print "NavigateForm: النموذج '" & formToOpen & "' غير موجود" End If MsgBox "النموذج '" & formToOpen & "' غير موجود في قاعدة البيانات.", vbExclamation, "خطأ" NavigateForm = False ' إعادة تعيين lastCall بعد الفشل lastCall = "" Exit Function End If End If Exit Function ErrHandler: If DebugPrintEnabled Then Debug.Print "NavigateForm: حدث خطأ: " & Err.Description End If MsgBox "حدث خطأ: " & Err.Description, vbExclamation, "خطأ" NavigateForm = False ' إعادة تعيين lastCall بعد الخطأ lastCall = "" End Function طريقة الاستخدام إنشاء الوحدة النمطية: افتح محرر VBA في (Alt + F11) أنشئ وحدة نمطية جديدة (Insert > Module) انسخ الكود أعلاه والصقه في الوحدة احفظ الوحدة النمطية باسم : basNavigateForm استدعاء الدالة: يمكن استدعاء NavigateForm من أحداث النماذج (مثل OnClick لزر) أو ماكرو أو كود VBA آخر أمثلة الاستدعاء: ' إغلاق النموذج الحالي Call NavigateForm ' إغلاق نموذج محدد Call NavigateForm("Form1") ' فتح نموذج في وضع الحوار Call NavigateForm("", "Form2", DialogMode) ' إغلاق Form1 وفتح Form2 في وضع إضافة سجل Call NavigateForm("Form1", "Form2", AddMode) ' فتح نموذج مع فلتر Call NavigateForm("", "Form2", NormalMode, , "CustomerID=123") ' فتح نموذج مع OpenArgs Call NavigateForm("", "Form2", DialogMode, "Source=MainForm") ' فتح نموذج مخفي Call NavigateForm("", "Form2", HiddenMode) ' فتح نموذج في وضع التصميم Call NavigateForm("", "Form2", DesignMode) ' فتح نموذج في عرض ورقة البيانات Call NavigateForm("", "Form2", DatasheetMode) وأخيـــــرا مرفق بسيط للتجربة NavigateForm (V2.1).accdb

السلام عليكم ورحمة الله تعالى وبركاته اليوم اقدم لكم هدية صغيرة ولكن النفع من ورائها عظيم جدا قد ينتج عن الكود اخطاء عند كتابة الكود قد نحتاج تتبع نتائج الكود قد محتاج معرفة القيم التى يعيدهها الكود قد نكتب استعلام مثلا زنقطع الاسطر ونضيف متغيرات نمرر منها قيما الى الاستعلام ونريد معرفة كبف سوف يراه الحاسوب فى النهاية وقد وقد و ........ الخ وهناك الكثير والكثير وما ذطرته هو فقط على سبيل المثال وليس الحصر اتتنى فكرة وهى كتابة كود فى موديول ليسهل الامور على مصممى قواعد البيانات فيضفى المرونة فى التعامل وكذا الاحترافية التامة مع هذا الامر وهو استخدام: Debug.Print وحتى لا اطيل عليكم اليكم الاكواد Option Compare Database Option Explicit '********************************************************************** ' Function: DebugPrint ' Purpose: Prints a message to the Immediate Window in the VBA editor and optionally logs it to a file. ' Inputs: ' Message - The message to be printed (String). ' Optional AddNewLine - A Boolean flag to add a new line after printing (default is True). ' Optional Prefix - A string to prefix the message (default is ""). ' Optional Suffix - A string to suffix the message (default is ""). ' Optional LogToFile - A Boolean flag to enable logging to a file (default is False). ' Optional FilePath - The path of the file where the log should be saved (default is ""). ' Returns: Nothing - The function performs a print and/or log operation. ' Notes: ' - The function sends the message to the Immediate Window. ' - If AddNewLine is True, a newline is added after the message. ' - Prefix and Suffix can be used to format the message. ' - LogToFile enables logging the message to a specified file. ' - Error handling is included to manage issues with file operations. '********************************************************************** ' Author: Officena.net , Mohammed Essm , soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub DebugPrint(ByVal Message As String, Optional ByVal AddNewLine As Boolean = True, _ Optional ByVal Prefix As String = "", Optional ByVal Suffix As String = "", _ Optional ByVal LogToFile As Boolean = False, Optional ByVal FilePath As String = "") Dim fullMessage As String Dim fileNum As Integer ' Construct the full message with prefix and suffix fullMessage = Prefix & Message & Suffix ' Print the message to the Immediate Window Debug.Print fullMessage ' Optionally add a newline after printing If AddNewLine Then Debug.Print "" ' Adds an empty line for separation End If ' Log the message to a file if specified If LogToFile And FilePath <> "" Then On Error GoTo ErrorHandler fileNum = FreeFile Open FilePath For Append As #fileNum Print #fileNum, fullMessage Close #fileNum On Error GoTo 0 End If Exit Sub ErrorHandler: ' Handle any errors that occur during file operations Debug.Print "Error occurred while logging to file: " & Err.Description On Error GoTo 0 End Sub ' Example 1: Print a simple message Rem Call DebugPrint("This is a simple message") ' Example 2: Print a message with a prefix and suffix, without adding a new line Rem DebugPrint("Error encountered!", AddNewLine:=False, Prefix:="Error: ", Suffix:=" [Check details]") ' Example 3: Print a message and log it to a file Rem DebugPrint("Logging this message to a file.", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt") ' Example 4: Print multiple messages with automatic new lines and logging Rem DebugPrint("Starting process...") Rem DebugPrint("Process in progress...") Rem DebugPrint("Process completed successfully!", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt") '--------------------------------------------------------------------------------------------------------------------------------------- '********************************************************************** ' Subroutine: OpenImmediateWindow ' Purpose: Opens the Immediate Window in the VBA editor and prepares it for input. ' Inputs: None ' Returns: Nothing ' Notes: ' - The Immediate Window is activated and ready for input. ' - This subroutine uses the SendKeys method to send keystrokes. ' - Error handling is included to manage potential issues with SendKeys. '********************************************************************** ' Author: Officena.net , Mohammed Essm , soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Sub OpenImmediateWindow() Dim shell As Object On Error GoTo ErrorHandler ' Create an instance of WScript.Shell to send keystrokes Set shell = CreateObject("WScript.Shell") With shell ' Send Ctrl+G to open the Immediate Window .SendKeys "^g ", True ' Send Tab to navigate if needed .SendKeys "{TAB}", True End With Application.VBE.MainWindow.Visible = True DoEvents 'this frees up the OS to repaint the screen Exit Sub ' Clean up Set shell = Nothing ErrorHandler: ' Handle any errors that occur during SendKeys operations Debug.Print "Error occurred while opening the Immediate Window: " & Err.Description On Error GoTo 0 End Sub '********************************************************************** ' Function: ClearImmediateWindowContent ' Purpose: Clears the content of the Immediate Window in the VBA Editor. ' Details: ' This function searches for an open Immediate Window within the VBE. ' If found, it sends keystrokes to clear the content using the WScript.Shell object. ' Inputs: None ' Returns: Void ' Error Handling: ' Includes basic error handling to inform the user in case of an issue. ' Notes: ' - This function assumes that there is only one Immediate Window open. ' - The function does not create a new Immediate Window if one is not found. '********************************************************************** Public Function ClearImmediateWindowContent() On Error GoTo ErrorHandler Dim totalVBEWindows As Long Dim currentWindowIndex As Long Const IMMEDIATE_WINDOW_TYPE As Long = 5 ' Type constant for Immediate Window Dim shell As Object ' Create an instance of WScript.Shell to send keystrokes Set shell = CreateObject("WScript.Shell") totalVBEWindows = Application.VBE.Windows.Count ' Get the number of open windows ' Iterate through all open windows For currentWindowIndex = 1 To totalVBEWindows ' Check if the current window is the Immediate Window If Application.VBE.Windows.Item(currentWindowIndex).Type = IMMEDIATE_WINDOW_TYPE Then Application.VBE.Windows.Item(currentWindowIndex).SetFocus ' Set focus to the Immediate Window ' Ensure the Immediate Window is active If Application.VBE.ActiveWindow.Type = IMMEDIATE_WINDOW_TYPE Then With shell ' Send Ctrl+G to activate the Immediate Window .SendKeys "^g", True ' Send Ctrl+A to select all content .SendKeys "^a", True ' Send Delete to clear selected content .SendKeys "{DEL}", True ' Send Backspace to ensure content is cleared .SendKeys "{BKSP}", True End With Exit Function ' Exit after clearing the content End If Exit For ' Exit the loop if Immediate Window is found and focused End If Next currentWindowIndex ' Clean up Set shell = Nothing Exit Function ErrorHandler: MsgBox "Error occurred while trying to clear the Immediate Window. Error: " & Err.Description, vbCritical ' Clean up Set shell = Nothing End Function '********************************************************************** ' Function: GetDesktopPath ' Purpose: Returns the path to the Desktop for the current user. ' Details: ' This function retrieves the path to the Desktop folder using Windows API functions. ' Inputs: None ' Returns: String - The full path to the Desktop folder. ' Notes: ' - This function uses Windows API to get the Desktop path. ' - Ensure you have error handling to manage unexpected issues. '********************************************************************** Public Function GetDesktopPath() As String Dim strDesktopPath As String Dim objShell As Object On Error GoTo ErrorHandler ' Create an instance of Shell object Set objShell = CreateObject("Shell.Application") ' Get the Desktop folder path strDesktopPath = objShell.NameSpace(&H10&).Self.Path ' Return the path GetDesktopPath = strDesktopPath Exit Function ErrorHandler: MsgBox "Error occurred while retrieving the Desktop path. Error: " & Err.Description, vbCritical GetDesktopPath = "" End Function بالمناسبة لا داعى للقلق من وجود واستخدام "SendKeys" داخل الاكود لانه تم التعامل معها بحرفية تامة كى لا تأثر على حالة الـ Num Lock ImmediateWindowHelper.accdb