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

السلام عليكم ورحمة الله تعالى وبركاته المصدر و الموضوع الاساسى : فى هذه المشاركة لأستاذى القدير و معلمى الجليل و والدى الحبيب الاستاذ جعفر ( @jjafferr ) بعد اذن استاذى الجليل و معلمى القدير وحتي تعم الفائدة أقتبس من الموضوع الأساسى بعض المقتطفات و التى هى الأساس : هناك 3 انواع من هذه القوائم : الثابته ، والمؤقته ، والمؤقته التي تحتاج الى كود. الثابته: وهي التي عندما نعملها ، تصبح مستقله عن الكود ، وتُحفظ وتبقى في قاعدة البيانات بعد إغلاقها ، ويمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى ، بإستخدام : . ونختارها في النموذج : . او التقرير : هذا مثال لعمل الكود الاساس لعمل قائمة قطع/نسخ/لصق : ومن هنا يبدأ موضوعى المتواضع بإعادة هيكلة وبناء وتطوير وإضافة الاكواد حسب فهمى المتواضع وأفكارى البسيطة والضئيلة الشرح :اولا الاكواد فى الموديول :basCommandBarsConfiguration Option Compare Database Option Explicit ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Constants for button states and control types Public Const BUTTON_STATE_DOWN As Integer = -1 ' BUTTON_STATE_DOWN: Indicates that a button is in a pressed or activated state. ' This value is used to reflect the button's pressed status. Public Const BUTTON_STATE_UP As Integer = 0 ' BUTTON_STATE_UP: Indicates that a button is in its default, unpressed state. ' This value is used to reflect the button's normal, unpressed status. Public Const CONTROL_TYPE_BUTTON As Integer = 1 ' CONTROL_TYPE_BUTTON: Represents a button control type in a command bar or menu. ' Used to add buttons to a command bar or menu with various functionalities. Public Const CONTROL_TYPE_EDIT As Integer = 2 ' CONTROL_TYPE_EDIT: Represents an editable control type, such as a text box. ' Used to add an editable text field to a command bar or menu. Public Const CONTROL_TYPE_COMBOBOX As Integer = 4 ' CONTROL_TYPE_COMBOBOX: Represents a combo box control type in a command bar or menu. ' A combo box allows users to select from a list of predefined options or enter a custom value. Public Const CONTROL_TYPE_POPUP As Integer = 5 ' CONTROL_TYPE_POPUP: Represents a popup menu or sub-menu control type. ' Used to create a dropdown menu or context menu in a command bar. Public Const BAR_TYPE_POPUP As Integer = 5 ' BAR_TYPE_POPUP: Represents a popup menu bar type. ' Used to create a command bar that behaves as a popup menu (e.g., appears on right-click or when invoked). ' Variables for CommandBar and Controls Public commandBar As Object ' Represents the custom command bar (popup menu) object Public commandButton As Object ' Represents each button/control added to the command bar Public commandBarName As String ' Name of the custom command bar Public CtrlFilterPopup As Object ' Represents the popup control for text filters '================================================================================ ' Procedure : AddButtonToCommandBar ' Purpose : Adds a button to a command bar with specified properties. ' Parameters: ' - btn: The button object to be added to the command bar. ' - type: The type of control (button). ' - id: The ID of the button. ' - caption: The caption text for the button. ' - beginGroup (optional): Boolean to indicate if a separator should be added before the button. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to add a button to the command bar Private Sub AddButtonToCommandBar(ByRef controls As Object, _ ByVal controlType As Integer, _ ByVal faceId As Integer, _ ByVal caption As String, _ Optional ByVal beginGroup As Boolean = False) On Error Resume Next Set commandButton = controls.Add(controlType, faceId, , , False) If Not commandButton Is Nothing Then With commandButton .caption = caption .faceId = faceId .beginGroup = beginGroup End With End If On Error GoTo 0 End Sub '================================================================================ ' Procedure : AddFilterControls ' Purpose : Adds filter controls to the provided controls collection in a filter popup. ' Parameters: ' - controls: The controls collection to which the filter controls will be added. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to add filter controls to the filter popup Private Sub AddFilterControls(ByRef controls As Object) With controls .Add CONTROL_TYPE_BUTTON, 10077, , , False .Add CONTROL_TYPE_BUTTON, 10078, , , False .Add CONTROL_TYPE_BUTTON, 10079, , , False .Add CONTROL_TYPE_BUTTON, 12696, , , False .Add CONTROL_TYPE_BUTTON, 10080, , , False .Add CONTROL_TYPE_BUTTON, 10081, , , False .Add CONTROL_TYPE_BUTTON, 10082, , , False .Add CONTROL_TYPE_BUTTON, 10083, , , False .Add CONTROL_TYPE_BUTTON, 12697, , , False .Add CONTROL_TYPE_BUTTON, 10058, , , False .Add CONTROL_TYPE_BUTTON, 10069, , , False .Add CONTROL_TYPE_BUTTON, 10070, , , False End With End Sub '================================================================================ ' Procedure : ClipboardActionsSortFilterCommandBar ' Purpose : Creates and configures a custom command bar with ClipboardActions (cut, copy, paste), sort, and filter options. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to create and configure the copy, sort, and filter command bar Public Sub ClipboardActionsSortFilterCommandBar() On Error GoTo ErrorHandler ' Handle errors ' Define the name of the custom command bar commandBarName = "ClipboardActionsSortFilterCommandBar" ' Ensure this matches the name you are checking ' Delete the existing command bar with the same name, if any On Error Resume Next Set commandBar = CommandBars(commandBarName) If Not commandBar Is Nothing Then commandBar.Delete End If If Err.Number <> 0 Then Err.Clear ' Create a new command bar Set commandBar = CommandBars.Add(Name:=commandBarName, Position:=BAR_TYPE_POPUP, Temporary:=False) With commandBar ' Add buttons to the command bar Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 21, "Cut") Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 19, "Copy") Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 22, "Paste") Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 210, "Sort Ascending", True) Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 211, "Sort Descending") Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 640, "Filter By Selection", True) Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 3017, "Filter Excluding Selection") Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 605, "Remove Filter/Sort") ' Add Filter For button with a popup menu Set CtrlFilterPopup = .controls.Add(Type:=CONTROL_TYPE_POPUP, Temporary:=False) If Not CtrlFilterPopup Is Nothing Then CtrlFilterPopup.caption = "Text Filters" ' Ensure CtrlFilterPopup is a CommandBarPopup If TypeName(CtrlFilterPopup) = "CommandBarPopup" Then ' Remove any existing controls For Each commandButton In CtrlFilterPopup.controls commandButton.Delete Next commandButton ' Add new controls to CtrlFilterPopup Call AddFilterControls(CtrlFilterPopup.controls) End If End If ' Add Close Form/Report button Set commandButton = .controls.Add(Type:=CONTROL_TYPE_BUTTON, ID:=923, Temporary:=False) If Not commandButton Is Nothing Then commandButton.beginGroup = True commandButton.caption = ChrW(1573) & ChrW(1594) & ChrW(1604) & ChrW(1575) & ChrW(1602) ' Close commandButton.OnAction = "CloseCurrentItem" ' Action to call the CloseCurrentItem subroutine End If End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing Set CtrlFilterPopup = Nothing Exit Sub ErrorHandler: ' MsgBox "An error occurred: " & Err.Description, vbExclamation ' Debug.Print "An error occurred in cmb_Copy_Sort_Filter : " & Err.Number & " | " & Err.Description Resume Next End Sub '================================================================================ ' Procedure : ClipboardActionsSortCommandBar ' Purpose : Creates and configures a custom command bar with ClipboardActions (cut, copy, paste), and sorting options. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to create and configure the custom command bar Public Sub ClipboardActionsSortCommandBar() On Error GoTo ErrorHandler ' Handle errors ' Define the name of the custom command bar commandBarName = "ClipboardActionsSortCommandBar" ' Name for the custom command bar ' Delete the existing command bar with the same name, if any On Error Resume Next Set commandBar = CommandBars(commandBarName) If Not commandBar Is Nothing Then commandBar.Delete End If If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(Name:=commandBarName, Position:=BAR_TYPE_POPUP, Temporary:=False) With commandBar ' Add buttons to the command bar using the new subroutine ' Add Cut button Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 21, ChrW(1602) & ChrW(1589)) ' Add Copy button Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 19, ChrW(1606) & ChrW(1587) & ChrW(1582)) ' Add Paste button Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 22, ChrW(1604) & ChrW(1589) & ChrW(1602)) ' Add Sort Ascending button Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 210, ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1589) & ChrW(1575) & ChrW(1593) & ChrW(1583) & ChrW(1610), True) ' Add Sort Descending button Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 211, ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1606) & ChrW(1575) & ChrW(1586) & ChrW(1604) & ChrW(1610), True) ' Add Close Form/Report button Set commandButton = .controls.Add(Type:=CONTROL_TYPE_BUTTON, ID:=923, Temporary:=False) If Not commandButton Is Nothing Then commandButton.beginGroup = True commandButton.caption = ChrW(1573) & ChrW(1594) & ChrW(1604) & ChrW(1575) & ChrW(1602) ' Close commandButton.OnAction = "CloseCurrentItem" ' Action to call the CloseCurrentItem subroutine End If End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing Exit Sub ErrorHandler: ' MsgBox "An error occurred: " & Err.Description, vbExclamation ' Debug.Print "An error occurred in cmb_CustomMenu : " & Err.Number & " | " & Err.Description Resume Next End Sub '================================================================================ ' Procedure : ClipboardActionsCommandBar ' Purpose : Creates and configures a custom command bar with ClipboardActions (cut, copy, paste). '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to create and configure the copy command bar Public Sub ClipboardActionsCommandBar() On Error GoTo ErrorHandler ' Handle errors ' Define the name of the custom command bar commandBarName = "ClipboardActionsCommandBar" ' Delete the existing command bar with the same name, if any On Error Resume Next Set commandBar = CommandBars(commandBarName) If Not commandBar Is Nothing Then commandBar.Delete End If If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(Name:=commandBarName, Position:=BAR_TYPE_POPUP, Temporary:=False) With commandBar ' Add buttons to the command bar Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 21, ChrW(1602) & ChrW(1589)) ' Cut Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 19, ChrW(1606) & ChrW(1587) & ChrW(1582)) ' Copy Call AddButtonToCommandBar(.controls, CONTROL_TYPE_BUTTON, 22, ChrW(1604) & ChrW(1589) & ChrW(1602)) ' Paste End With ' Clean up Set commandBar = Nothing Exit Sub ErrorHandler: ' MsgBox "An error occurred: " & Err.Description, vbExclamation ' Debug.Print "An error occurred in SCM_Copy : " & Err.Number & " | " & Err.Description Resume Next End Sub '================================================================================ ' Procedure : ReportContextMenuCommandBar ' Purpose : Creates and configures a custom report command bar with various ' printing, setup, and export options for reports. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to create and configure the custom report command bar Public Sub ReportContextMenuCommandBar() On Error GoTo ErrorHandler ' Handle errors Dim exportSubMenu As Object ' New variable for sub-menu handling ' Define the command bar name commandBarName = "ReportContextMenuCommandBar" ' Delete the existing command bar with the same name, if any On Error Resume Next Set commandBar = CommandBars(commandBarName) If Not commandBar Is Nothing Then commandBar.Delete End If If Err.Number <> 0 Then Err.Clear ' Create the shortcut menu Set commandBar = CommandBars.Add(Name:=commandBarName, Position:=BAR_TYPE_POPUP, Temporary:=False) ' Ensure commandBar was created successfully If commandBar Is Nothing Then MsgBox "Failed to create command bar.", vbExclamation Exit Sub End If With commandBar.controls ' Add the Print command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=2521), CONTROL_TYPE_BUTTON, 2521, "Quick Print") ' Add the Select Pages command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=15948), CONTROL_TYPE_BUTTON, 15948, "Select Pages") ' Add the Page Setup command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=247), CONTROL_TYPE_BUTTON, 247, "Page Setup") ' Add the Email Report as an Attachment command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=2188), CONTROL_TYPE_BUTTON, 2188, "Email Report as an Attachment", True) ' Add the Save as PDF/XPS command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=12499), CONTROL_TYPE_BUTTON, 12499, "Save as PDF/XPS") ' Add Export to Word and Excel commands as sub-items of the PDF/XPS button If .Count >= 5 Then ' Add sub-menu for PDF/XPS button Set exportSubMenu = .Item(5).controls.Add(Type:=CONTROL_TYPE_POPUP, Temporary:=False) exportSubMenu.caption = "Export Options" ' Add Export to Word Set commandButton = exportSubMenu.controls.Add(Type:=CONTROL_TYPE_BUTTON, ID:=11725, Temporary:=False) If Not commandButton Is Nothing Then commandButton.caption = "Export to Word..." commandButton.faceId = 42 End If ' Add Export to Excel Set commandButton = exportSubMenu.controls.Add(Type:=CONTROL_TYPE_BUTTON, ID:=11723, Temporary:=False) If Not commandButton Is Nothing Then commandButton.caption = "Export to Excel…" commandButton.faceId = 263 End If End If ' Add the Close Report command Call AddButtonToCommandBar(.Add(Type:=CONTROL_TYPE_BUTTON, ID:=923), CONTROL_TYPE_BUTTON, 923, "Close Report", True) End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing Set exportSubMenu = Nothing Exit Sub ErrorHandler: ' MsgBox "An error occurred: " & Err.Description, vbExclamation ' Debug.Print "An error occurred in CreateReportShortcutMenu : " & Err.Number & " | " & Err.Description Resume Next End Sub '================================================================================ ' Procedure : CloseCurrentItem ' Purpose : Closes the currently active form or report in the application. If no form ' or report is active, it displays a message to the user. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to close the currently active form or report Public Sub CloseCurrentItem() On Error GoTo ErrorHandler Dim obj As Object Dim activeItemName As String Dim isFormActive As Boolean Dim isReportActive As Boolean ' Check if an active form is open and close it isFormActive = False For Each obj In Forms If obj.Name = Screen.ActiveForm.Name Then activeItemName = obj.Name isFormActive = True Exit For End If Next obj If isFormActive Then DoCmd.Close acForm, activeItemName Exit Sub End If ' Check if an active report is open and close it isReportActive = False For Each obj In Reports If obj.Name = Screen.ActiveReport.Name Then activeItemName = obj.Name isReportActive = True Exit For End If Next obj If isReportActive Then DoCmd.Close acReport, activeItemName Exit Sub End If ' If no form or report is active, display a message MsgBox "There is no active form or report to close.", vbExclamation Exit Sub ErrorHandler: ' MsgBox "An error occurred: " & Err.Description, vbExclamation ' Debug.Print "An error occurred: " & Err.Number & " | " & Err.Description Resume Next End Sub '================================================================================ ' Procedure : DeleteAllCommandBars ' Purpose : Deletes all custom (non-built-in) command bars. '================================================================================ ' Author: www.officena.net , Mohammed Essam, soul-angel@msn.com, July 2024. ' Subroutine to Deletes all custom command bars. Public Sub DeleteAllCommandBars() On Error GoTo ErrorHandler ' Handle errors Dim i As Integer Dim cmdBar As Object Dim cmdBarsCount As Integer ' Get the count of command bars cmdBarsCount = CommandBars.Count ' Iterate through all command bars in reverse order For i = cmdBarsCount To 1 Step -1 On Error Resume Next ' Ignore errors if they occur during deletion Set cmdBar = CommandBars(i) If Not cmdBar Is Nothing Then ' Check if the command bar is not built-in or default If Not cmdBar.BuiltIn Then cmdBar.Delete Debug.Print "CommandBar '" & cmdBar.Name & "' has been deleted." End If End If On Error GoTo ErrorHandler ' Restore error handling Next i ' Clean up Set cmdBar = Nothing Exit Sub ErrorHandler: ' Display a more specific error message ' MsgBox "An error occurred while trying to delete command bars: " & Err.Description, vbExclamation ' Debug.Print "An error occurred in DeleteAllCommandBars: " & Err.Number & " | " & Err.Description Resume Next End Sub الثوابت : BUTTON_STATE_DOWN: قيمة ثابتة تستخدم للإشارة إلى أن الزر في حالة ضغط أو تفعيل ويستخدم هذا لإظهار حالة الزر عند الضغط عليه BUTTON_STATE_UP: قيمة ثابتة تستخدم للإشارة إلى أن الزر في حالته الطبيعية أو غير المضغوط عليها يستخدم هذا لإظهار حالة الزر عند عدم الضغط عليه CONTROL_TYPE_BUTTON: قيمة ثابتة تستخدم لتمثيل نوع التحكم "زر" في شريط الأوامر : ( قائمة السياق ) CONTROL_TYPE_EDIT: قيمة ثابتة تستخدم لتمثيل نوع التحكم "محرر" مثل صندوق النص يستخدم لإضافة حقل نص قابل للتعديل في شريط الأوامر : ( قائمة السياق ) CONTROL_TYPE_COMBOBOX: قيمة ثابتة تستخدم لتمثيل نوع التحكم "قائمة منسدلة" القائمة المنسدلة تسمح للمستخدمين بالاختيار من قائمة محددة مسبقا أو إدخال قيمة مخصصة CONTROL_TYPE_POPUP: قيمة ثابتة تستخدم لتمثيل نوع التحكم "قائمة منبثقة" أو "قائمة فرعية" تُستخدم لإنشاء قائمة منسدلة أو قائمة سياقية في شريط الأوامر BAR_TYPE_POPUP: قيمة ثابتة تُستخدم لتمثيل نوع شريط الأوامر المنبثق. يُستخدم لإنشاء شريط أدوات يظهر عند النقر بالزر الأيمن أو عند استدعائه -------------- المتغيرات : commandBar: يمثل كائن شريط الأوامر المخصص (قائمة السياق) commandButton: يمثل كل زر/تحكم يتم إضافته إلى شريط الأوامر commandBarName: اسم شريط الأوامر المخصص CtrlFilterPopup: يمثل التحكم المنبثق للفلاتر النصية -------------- الدوال : دالة : AddButtonToCommandBar الغرض: إضافة زر إلى شريط الأوامر مع الخصائص المحددة المعلمات: controls: مجموعة التحكمات التي سيتم إضافة الزر إليها controlType: نوع التحكم (زر في هذه الحالة) faceId: معرف الأيقونة للزر caption: نص التسمية للزر beginGroup (اختياري): منطق لبدء مجموعة جديدة مع الزر، مما يضيف فاصلًا قبله -------------- دالة : AddFilterControls الغرض: إضافة عناصر التحكم بالفلاتر إلى مجموعة التحكمات المحددة في قائمة منبثقة للفلاتر المعلمات: controls: مجموعة التحكمات التي سيتم إضافة عناصر الفلاتر إليها -------------- دالة : ClipboardActionsSortFilterCommandBar الغرض: إنشاء وتكوين شريط أوامر مخصص يتضمن خيارات الحافظة (قص، نسخ، لصق)، والفرز، والفلاتر العملية: إنشاء شريط أوامر جديد ( قائمة السياق ) إضافة أزرار للقص، النسخ، اللصق، الفرز، والفلاتر إضافة قائمة منبثقة للفلاتر النصية إضافة زر لإغلاق النموذج/التقرير -------------- دالة : ClipboardActionsSortCommandBar الغرض: إنشاء وتكوين شريط أوامر جديد ( قائمة السياق ) يتضمن خيارات الحافظة (قص، نسخ، لصق), والفرز العملية: إنشاء شريط أوامر جديد إضافة أزرار للقص، النسخ، اللصق، والفرز إضافة زر لإغلاق النموذج/التقرير -------------- دالة : ClipboardActionsCommandBar الغرض: إنشاء وتكوين شريط أوامر مخصص يتضمن خيارات الحافظة (قص، نسخ، لصق) العملية: إنشاء شريط أوامر جديد إضافة أزرار للقص، النسخ، واللصق -------------- دالة : ReportContextMenuCommandBar الغرض: إنشاء وتكوين شريط أوامر مخصص لقائمة السياق الخاصة بالتقرير، يتضمن خيارات الطباعة، الإعداد، والتصدير العملية: إنشاء شريط أوامر جديد إضافة أزرار لطباعة، اختيار الصفحات، إعداد الصفحة، إرسال التقرير بالبريد الإلكتروني كمرفق، حفظ كـ PDF/XPS إضافة خيارات تصدير إلى Word و Excel كعناصر فرعية لزر PDF/XPS إضافة زر لإغلاق التقرير -------------- دالة : CloseCurrentItem الغرض: إغلاق النموذج أو التقرير النشط حاليا في التطبيق العملية: التحقق مما إذا كان هناك نموذج نشط وإغلاقه التقق مما إذا كان هناك تقرير نشط وإغلاقه -------------- دالة : DeleteAllCommandBars الغرض: حذف جميع أشرطة الأوامر المخصصة (غير المدمجة) في التطبيق العملية: الحصول على عدد أشرطة الأوامر: يتم الحصول على عدد أشرطة الأوامر الحالية باستخدام CommandBars.Count التكرار من آخر شريط أوامر إلى أول شريط أوامر (من النهاية إلى البداية) لضمان عدم حدوث أخطاء أثناء الحذف حذف أشرطة الأوامر: إذا لم يكن الشريط مدمجًا (أي أنه شريط مخصص) يتم حذف الشريط -------------- واخيرا استدعاء الدالة عند تحميل النموذج أو التقرير: استدعاء دالة: Call RoutineNameCustomCommandBar يتم استدعاء دالة مع تغيير RoutineNameCustomCommandBar باسم الدالة الخاصة بإنشاء وتكوين شريط الأوامر المخصص حيث تقوم بإنشاء أو تعديل شريط الأوامر (CommandBar) الخاص بالنموذج أو التقرير تعيين خاصية ShortcutMenuBar: Me.ShortcutMenuBar = RoutineNameCustomCommandBar يتم تعيين خاصية ShortcutMenuBar للنموذج أو التقرير إلى اسم شريط الأوامر الذي تم إنشاؤه أو تعديله أثناء استدعاء الدالة المخصصة بهذه الطريقة يتم ربط شريط الأوامر المخصص بقائمة الاختصارات (shortcut menu) للنموذج أو التقرير الحالي ارقام جميع الصور الموجودة في الاكسس والتى نستخدمها كمعلمة فى faceId معرف الأيقونة للزر المصادر: الموضوع الاساسى فى هذا المنتدى لأستاذى القدير و معلمى الجليل و والدى الحبيب الاستاذ جعفر https://www.officena.net/ib/topic/99557-القائمة-المختصرة-shortcut-menu/#comment-603366 http://dev-soln.com/access-shortcut-right-click-tool/ https://www.experts-exchange.com/articles/12904/Understanding-and-using-CommandBars-Part-II-Creating-your-own.html https://filedb.experts-exchange.com/incoming/2014/02_w06/833359/CommandBars-II.mdb https://www.experts-exchange.com/articles/18341/CommandBars-Part-III-Using-Built-in-Shortcut-Menus.html http://www.skrol29.com/us/vtools.php CommandBarsConfiguration.accdb

-تجهيز مجلدات وملف الصوت الخطوة الاولى قم بانشاء مجلد جديد فى مسار قاعدة البيانات الحالى باسم ( Resurce ) الخطوة الثانية قم بفتح المجلد السابق وقم بانشاء مجلد جديد بداخله باسم ( Audio Files ) الخطوة الثالثة قم بنسخ ملف صوت الى المجلد ( Audio Files ) اما بامتداد wav , .mp3. --------------------- -تجهيز قاعدة البيانات الخطوة الاولى قم بانشاء وحدة نمطية باسم ( modPlayAudio ) وقم بلصق الاكواد الاتية فى هذه الوحدة النمطية Option Compare Database Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare PtrSafe Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #Else Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long #End If Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private sMusicFile As String Public soundOn As Boolean Dim mp3Path As String Dim wavPath As String Dim Play As Variant Public Sub Sound_MP3(ByVal File$) sMusicFile = GetShortPath(File) Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then End If End Sub Public Sub Stop_MP3(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Public Function GetShortPath(ByVal strFileName As String) As String Dim lngRes As Long, strPath As String strPath = String$(165, 0) lngRes = GetShortPathName(strFileName, strPath, 164) GetShortPath = Left$(strPath, lngRes) End Function Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory) End Function Public Function AudioFilePath() As String AudioFilePath = CurrentProject.Path & "\Resurce\Audio Files\" End Function Public Function PlayFile(ByVal FileName_ As String) Dim Msg As String Msg = ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1608) & ChrW(1580) & _ ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(40) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & _ ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) & _ ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & _ ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & _ ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & _ ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(1601) & ChrW(1609) & ChrW(32) & ChrW(1575) & _ ChrW(1604) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & _ ChrW(1581) & ChrW(1583) & ChrW(1583) & ChrW(32) & ChrW(46) & ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & _ ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1575) & ChrW(1587) & ChrW(1605) & _ ChrW(32) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & _ ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & _ ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) mp3Path = AudioFilePath & FileName_ & ".mp3" wavPath = AudioFilePath & FileName_ & ".wav" StopFile If IsFile(mp3Path) Then Sound_MP3 (mp3Path): Exit Function If IsFile(wavPath) Then playSound (wavPath), vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC: Exit Function If IsFile(mp3Path) = IsFile(wavPath) Then MsgBox (Msg), vbOKOnly + vbMsgBoxRtlReading + vbMsgBoxRight: Exit Function End Function Public Function StopFile() playSound vbNullString, ByVal 0&, SND_NODEFAULT Stop_MP3 (mp3Path) End Function الخطوة الثانية قم بانشاء نموذج باسم ( frmPlayAudio ) الخطوة الثالثة قم بانشاء مربع نص فى النموذج السابق باسم ( txtAudioFileName ) الخطوة الرابعة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdPlay ) وفى حدث عند النقر ضع الكود الاتى soundOn = True: PlayFile (Me.txtAudioFileName) الخطوة الخامسة قم بانشاء زر أمر فى النموذج السابق باسم ( cmdStop ) وفى حدث عند النقر ضع الكود الاتى StopFile الخطوة السادسة فى حدث عند إغلاق النموذج ضع الكود الاتى StopFile الخطوة السابعة بعد حفظ ما سبق افتح النموذج وادخل فى مربع النص ( txtAudioFileName ) اسم ملف الصوت الموجود فى المسار المحدد بدون الامتداد مثلا لو ملف الصوت باسم : MyAudio.mp3 Or MyAudio.wav اسم ملف الصوت فى مربع النص ( txtAudioFileName ) يكون فى الشكل الاتى فقط : MyAudio والان جرب الضغط على زر الامر الخاص بالتشغيل تارة وزر الامر الخاص بالايقاف تارة أخرى طيب ملاحظة مهمه : الطريقة ودوال API هنا تقوم بتشغيل ملفات صوت من النوعين MP3 . WAV <<---< والله دلع شغل فاخر من الأخر تم صياغة الكود بمرونه مطلقة للتعامل مع الملف بغض النظر عن امتداد الملف اه والله زيمبئولك كده مش مصدق ليه مش بئولك شغل فاخر اللى مش عاجبه المسار لملفات الصوت او عاوز يغير مكانها او اسمها طبعا فى الموديول يغير فى الروتين ده على مزاجه AudioFilePath() انا شرحت بالتفصيل الممل اياك حد يقول لى عاوز مرفق أو مش عارف يطبق الشرح