ابو جودي

هههههههه مش حقول لك

لاحظى ان كلامك جارح وبتحكى عنى انا مش البعض انا كلهم

هى افكار جميلة فعلا بس عندى راى واتمنى قبولة بصدر رحب هذة الفكرة تتطلب نموذج خاص واذا حابين نعمل اكثر من قائمة تكون لن قول مستحيلة لا اعترف بالمستحيل ولكن صعوبة التحقيق سوف تكون عائق لا مفر منه استهلاك مساحات وعدد من المائنات من الاكسس بدون داعى اذا ممكن تحقيق كل ذلك من خلال الاوامر الاكسس افضل مرونة واسهل واسرع بالاخص عند الاضافة والتحديث والتخليق الجديد الذى سوف يكون له اساس اصلا من البداية يتم البناء عليه او من خلاله او بواسطته او بمثيله فطعا وطبعا لا اقلل من الافكار الجميلة ولا من الابداع ولكن دعونا لا ننسى ان قواعد بيانات الاكسس فقيرة نوعا ما و صغيرة كل تقليل تسطيع اكتسابة من توفير موارد الجهاز والنظام سوف يمكنك من الحصول على افضل واسرع اداء والذى سيكون اكثر استقرار لقاعدة البيانات مع الضغط عليها فى بداية مشوارى كنت انبهر بالديكورات والجماليات والبهرجة التى اكتشفت مؤخرا انها هدر للوقت والجهد والطاقة والموارد والاداء والاستقرار و و و و و.......... ولكن لازلت عندر رأى انا دائما تبهرنى افكار الباش مهندسة ولكن افضل البساكة واقدم سرعة الاداؤ والاستقرار على اى شئ وفى النهاية هذه وجخة نظر العبد الفقير المتواضعة

طيب الكودين تحت المجهر >>-----> الكود الاول للاستاذ العظيم @Foksh والكود الثانى اللى هو احسن طبعا <<----< مين يشهد للعروسة الكود الاول : استخدام AddItem لإضافة العناصر بشكل فردي بدلا من بناء سلسلة نصية يقوم الكود بإضافة أسماء الحقول إلى قائمة ListFields بشكل فردي باستخدام AddItem عدم التعامل مع الأخطاء الكود لا يحتوي على أي تعامل مع الأخطاء مما قد يسبب أخطاء غير متوقعة إعداد RowSource في بداية العملية يتم إعداد RowSource وإفراغه قبل البدء في إضافة العناصر عدم استخدام جملة sql جملة sql الموجودة في الكود لا تؤثر على الكود ويمكن إزالتها لأنها غير مستخدمة الكود الثانى : استخدام متغير rowSourceString لبناء قائمة ListFields الكود يجمع كل أسماء الحقول في سلسلة نصية مفصولة بفواصل إعداد RowSource مباشرة بسلسلة نصية في النهاية حيث يقوم الكود بإعداد RowSource لقائمة ListFields باستخدام السلسلة النصية التي تم بناؤها التعامل مع الأخطاء بشكل آمن يتم التعامل مع الأخطاء عند محاولة الوصول إلى خاصية "Caption" في الحقول بشكل آمن عبر استخدام On Error Resume Next ثم On Error GoTo 0 بعد محاولة الوصول مسح الذاكرة بشكل صحيح: يتم تعيين المتغيرات db و td إلى Nothing في النهاية، مما يساعد على تحرير الذاكرة. المرونة والأداء: الكود الثانى قد يكون أفضل من حيث الأداء ده كده كده لانه بتاعى بالعند فيك يا استاذ @Foksh حيث يتم بناء السلسلة النصية مرة واحدة ثم تعيينها إلى RowSource بدلاً من إضافة العناصر بشكل فردي كما في الكود الاول فى الكود الثانى يتم التعامل مع الأخطاء بشكل صحيح مما يجعله نسبيا ً أكثر استقراراً وضوح الكود : الكود الثانى أكثر وضوحاً وسهولة في الفهم ده كده كده برضو لتانى مرة حيث يتم جمع أسماء الحقول ثم تعيينها دفعة واحدة بدلاً من الإضافة الفردية الخلاصة بقة لان ده شغل فاخر من الاخر : الكود الثانى يعتبر أفضل بسببين بس بعد الرغى ده كله ومعاكسة اغلى الغوالى 1- تعامله الأفضل مع الأخطاء 2- فعاليته في الأداء من خلال إعداد RowSource دفعة واحدة ووضوحه في التنفيذ من غير ما تدخل تزعق يا عم @Foksh هدى اعصابك بس روح ع الجدول وامسح اى تسمية لاى حقل وجرب

الشرح : - تعريف المتغيرات اللازمة ' Declare variables Dim db As DAO.Database Dim td As DAO.TableDef Dim fld As DAO.Field Dim fldCaption As String Dim rowSourceString As String - الحصول على قاعدة البيانات الحالية وتعريف الجدول ' Get the current database Set db = CurrentDb ' Get the selected table definition Set td = db.TableDefs(Me.cmb_TQ.Value) - إفراغ محتويات القائمة الحالية وتعيين عدد الأعمدة إلى 1 ' Clear the contents of the current listbox Me.ListFields.RowSource = "" ' Set the number of columns to 1 Me.ListFields.ColumnCount = 1 - بناء سلسلة النصوص التي تحتوي على التسميات أو أسماء الحقول ' Initialize the string to build captions or field names rowSourceString = "" ' Loop through each field in the table definition For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name On Error Resume Next fldCaption = fld.Properties("Caption") On Error GoTo 0 If IsNull(fldCaption) Or fldCaption = "" Then fldCaption = fld.Name End If ' Add the caption or field name to the string rowSourceString = rowSourceString & fldCaption & ";" Next fld - إزالة الفاصلة الزائدة من نهاية السلسلة ' Remove the trailing semicolon from the end of the string If Len(rowSourceString) > 0 Then rowSourceString = Left(rowSourceString, Len(rowSourceString) - 1) End If - تعيين مصدر الصفوف للتحكم ListFields ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = rowSourceString - تحرير الذاكرة ' Clear memory Set db = Nothing Set td = Nothing - التحقق من وجود التسمية ' Check if the Caption property exists If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If - عمل دالة للتحقق من وجود التسمية Private Function FieldHasCaption(fld As DAO.Field) As Boolean On Error Resume Next FieldHasCaption = Not IsNull(fld.Properties("Caption")) On Error GoTo 0 End Function - استخدام مصفوفة لتخزين أسماء الحقول ومن ثم تعيين مصدر الصفوف مرة واحدة Dim captions() As String Dim i As Integer ReDim captions(td.Fields.Count - 1) ' Loop through each field in the table definition i = 0 For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If captions(i) = fldCaption i = i + 1 Next fld ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = Join(captions, ";") المميزات إضافة الدالة FieldHasCaption والتى تتحقق من وجود خاصية "Caption" بطريقة احترافية استخدام مصفوفة لتخزين أسماء الحقول ومن ثم تعيين مصدر الصفوف مرة واحدة لتحسين الأداء بس خلاص

بس كده غالى والطلب رخيص من عيونى الجوز انت تأمر اتفضل الكود اهو يا قمر Private Sub cmb_TQ_AfterUpdate() ' Declare variables Dim db As DAO.Database Dim td As DAO.TableDef Dim fld As DAO.Field Dim fldCaption As String Dim captions() As String Dim i As Integer ' Get the current database Set db = CurrentDb ' Get the selected table definition Set td = db.TableDefs(Me.cmb_TQ.Value) ' Clear the contents of the current listbox Me.ListFields.RowSource = "" ' Set the number of columns to 1 Me.ListFields.ColumnCount = 1 ' Initialize the array to store captions or field names ReDim captions(td.Fields.Count - 1) ' Loop through each field in the table definition i = 0 For Each fld In td.Fields ' Check if the Caption property exists and use it; otherwise, use the field name If FieldHasCaption(fld) Then fldCaption = fld.Properties("Caption") Else fldCaption = fld.Name End If ' Add the caption or field name to the array captions(i) = fldCaption i = i + 1 Next fld ' Set the row source for the ListFields control Me.ListFields.RowSourceType = "Value List" Me.ListFields.RowSource = Join(captions, ";") ' Clear memory Set db = Nothing Set td = Nothing End Sub Private Function FieldHasCaption(fld As DAO.Field) As Boolean On Error Resume Next FieldHasCaption = Not IsNull(fld.Properties("Caption")) On Error GoTo 0 End Function

طيب قبل ما احاول عمل اى شئ ممكن تقولى استخدام النموذج بالتفصيل ؟؟ يعنى انت عامل النموذج للحث من خلال مربعات السرد وايضا اضافة بيانات جديدة من خلال المربعات ؟؟؟ امممم وشئ تانى لاحظته فى النرفق الاخير هو لو عدلت المنصب فى اى سجل تم ادخاله وحفظه فى القاعدة باضافة شئ او متابته من مربع السرد هل انت موافق انه يتم تعديله فى الجدول اللى باسم المنصب باللغة العربية ؟؟ فيكون عندك منصب فيه جديد وغير موجود فى جدول المنصب باللغة الانجليوية واللى اسمه Tbl_Manaseb اممممممم قاعدة البيانات تحتاج الى شئ واحد فقط اجتياح >>---> انسف حمامك القديم لو تم البناء على اساس صحيح يعيش البناء ويستمر اما بهذا الشكل لا انصحك بالاستمرار على هذا الاساس الهش ولا تكمل بهذه الطريقة هتتعب قوى وكتير

شكل الكود هاد ما بيحب احمد هاهاههاا شوفتوا بقه فايدة ان الواحد يبقى اسمه محمد عن نفسي انا كمحمد مبسوط والله

يا استاذ @ahmed_204079 افندى المرفق اللى حضرتك وضعته مش بتاعك لان فى اكواد غلط وفى حجات ناقصة و و بلا بلا بلا...... ارجو منك لو تكرمت وفضلا وليس امرا لو المرفق الاساسى لموضوع التصدير موجود بدون التعديلات اللى خربت الدنيا فيه دى ارجوك ارفقه لانى محتاج اذاكره وكنت جهزت لك موضوع الليست بوكس وعلى ما رجعت من الشغل جيت ارفقه لاقيت اخونا الهمام الله يبارك بعمره الاستاذ @Foksh قام بالواجب على اكمل وجه الله يبارك له

العفو منكم استاذى الجليل وملمى القدير انا اقل طويلب علم ينهل من ينابيع علومكم انتم وباقى الاساتذة العظماء يعلم الله تعالى انا تعلمت ولازلت اتعلم على اياديكم بارك الله لنا فيكم وكل اساتذتى وجعل الله لكم بكل حرف حسنة ويضاعف لكم من واسع فضله عليكم اضعافا مضاعفة هههههه اسف الرد متأخر جدا النور قطع ونسيت والله

تمعن فى هذا الجمال بدلا من ذلك العناء مع iif Switch( [ASNAF.UNIT] = [SAP.UNIT], "YYY", [ASNAF.UNIT] = [SAP.ADDITION UNIT], "YYY",True, "NNN" ) والله دالة سويتش جميلة وبنت حلال ليه تتجاهلونها يا اخوان عمالة تشتكى لى وتعيط منكم ده حتى كمان طيبة ومسكينة و لا تقلب الدنيا راسا على عقب لو تم استخدامها مع اللغة العربية بعكس بنت اللذينة iif دى اه والله زيمبئولكم كده بالمناسبة انا كاتبها صح مش غلط بس قاصد كتابتها كده علشان تشوفوا سهولة كتابتها عند الاستخدام وعلى سطر واحد تكون Switch([ASNAF.UNIT] = [SAP.UNIT], "YYY", [ASNAF.UNIT] = [SAP.ADDITION UNIT], "YYY", True, "NNN") وكما تلاحظون تكتب مرة واحدة بس لو هتعمل ميت شرط بطريقة اكثر تعقيدا ناهيك عن عدد مرات استخدام iif مع الشروط وعدد الاقواس وترتيبها

ارفق القاعدتان

باش مهندسة @hanan_ms فكرة حلوة وانا كمحمد مبسوط منها شغلك وافكارك بصراحة حلوة جدا شابوه بجد

لا كتير على الكلام الحلو هاد ترانى طاير للسحاب من فرط الفرحة بشهادة استاذى الجليل <<--< واخرتها الوقوع على رقبتى يا حبيبى انا قلت لازم نفرض ضريبه ع المكتبة دى محدش عاوز يسمع كلامى وانا ايضا منتظر مكتبتى خاويه <<---< مثل مخ صاحبها بالتمام

السلام عليكم هل تقبلون تجربة احد جيرانكم من منتدى الاكسس جرب الكود الاتى ' This function rounds a given value to the nearest multiple of a specified value. ' It uses Excel's built-in RoundUp and RoundDown functions to perform the rounding. ' ' Parameters: ' mainVal: The value to be rounded (of type Double). ' roundVal: The multiple to which mainVal will be rounded (of type Double). ' ' Returns: ' The rounded value as a Double. ' If roundVal is zero or an error occurs, the function returns 0. ' ' Error Handling: ' The function raises an error if roundVal is zero to prevent division by zero. ' If any other error occurs, a message box displays the error number and description. Function MyRound(ByVal mainVal As Double, ByVal roundVal As Double) As Double Dim h As Double, v As Double Dim remainder As Double On Error GoTo ErrSub ' Check if roundVal is zero to avoid division by zero error If roundVal = 0 Then Err.Raise vbObjectError + 9999, "MyRound", "RoundVal cannot be zero." End If ' Calculate half of roundVal h = roundVal / 2 ' Calculate the remainder of mainVal divided by roundVal remainder = mainVal - Int(mainVal / roundVal) * roundVal ' Determine whether to round up or down based on the remainder and half of roundVal If mainVal >= 0 Then If remainder >= h Then v = Application.WorksheetFunction.RoundUp(mainVal / roundVal, 0) * roundVal Else v = Application.WorksheetFunction.RoundDown(mainVal / roundVal, 0) * roundVal End If End If ' Return the rounded value MyRound = v Exit Function ErrSub: ' Handle errors and provide a meaningful message MsgBox "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbCritical + vbMsgBoxRight MyRound = 0 End Function وفكرة أخرى تعتمد على العمليات الجسابية بعيدا عن الدوال Function MyRound(ByVal mainVal As Double, ByVal roundVal As Double) As Double Dim roundedValue As Double Dim quotient As Double On Error GoTo ErrHandler ' Check if roundVal is zero to avoid division by zero error If roundVal = 0 Then Err.Raise vbObjectError + 9999, "MyRound", "RoundVal cannot be zero." End If ' Calculate the quotient of mainVal divided by roundVal quotient = mainVal / roundVal ' Determine whether to round up or down based on the quotient If quotient - Int(quotient) >= 0.5 Then roundedValue = Application.WorksheetFunction.RoundUp(quotient, 0) * roundVal Else roundedValue = Application.WorksheetFunction.RoundDown(quotient, 0) * roundVal End If ' Return the rounded value MyRound = roundedValue Exit Function ErrHandler: ' Handle errors and provide a meaningful message MsgBox "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbCritical + vbMsgBoxRight MyRound = 0 End Function

السلام عليكم ورحمة الله تعالى وبركاته المصدر و الموضوع الاساسى : فى هذه المشاركة لأستاذى القدير و معلمى الجليل و والدى الحبيب الاستاذ جعفر ( @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

منتظر بلهفة مشتاق ربما اكون لك داعما فى تجميع الافكار اهديكم بنات افكارى فى المشاركة التالية التى سوف انوه عنها لاحقا فى نهاية هذه المشاركة وانت يا استاذ يوسف اليك الحل من وجهة نظرى المتواضعة ليسهل نقل الاكواد الى اى قاعدة تقريبا جمعت كل الاكواد الممكنة فى موديول واحد وانظر بنفسك الى المرفق فى : المشاركة الآتية من هنا افدم اعتذارى لفتح موضوع جديد ليكون شامل وواف بالشرح ليكون اثراء ومرجعا يسهل العثور عليه

انت يا صديقى لم تفعل الخطوة السابقة انتظر انا اقوم بعمل فكرة تتخطى هذه المشكلة لو تمت سوف اوافيكم بها الفكره سوف تقوم هى بطريقة الية بعمل كل شئ دون اى تدخل من المستخدم

ملحوظة انا اضفت كود الى قائمة السياق لاغلاق ايا كان تقرير او نموذج وذلك لاضفاء المرونة التامة لاستخدام نفس قائمة السياق ان اردنا مع اى نموذج او تقرير دون كتابة العديد من الاكواد امممممم طبعا نصيحتى الذهبية انا قدمت اليك الكود مستخدما الاحرف العربية داخل المحرر وهذا ما لا احبذه انصحك وان اردت استخدام اللغة العربية تحويلها من خلال التطبيق التالى وبذلك تكون الاكواد بالطربقة المثلى داخل الموديول بالشكل التالى Option Compare Database Option Explicit ' Constants for button states and control types Public Const BUTTON_STATE_DOWN As Integer = -1 ' BUTTON_STATE_DOWN: Represents the state where a button is pressed down or activated. ' Used to indicate that a button is in the pressed state. Public Const BUTTON_STATE_UP As Integer = 0 ' BUTTON_STATE_UP: Represents the state where a button is in its normal (not pressed) state. ' Used to indicate that a button is not pressed or activated. 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. Public Const CONTROL_TYPE_EDIT As Integer = 2 ' CONTROL_TYPE_EDIT: Represents an edit control type, such as a text box. ' Typically 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 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 new command bar that behaves as a popup menu (i.e., appears on right-click or when invoked). ' Variables for CommandBar and Controls Public commandBar As Object ' Represents the custom command bar (popup menu) Public commandButton As Object ' Represents each button/control added to the command bar Public commandBarName As String ' Name of the custom command bar ' Subroutine to create and configure the custom command bar Public Sub CreateCustomCommandBar() ' Ignore errors during creation or deletion of the command bar On Error Resume Next ' Define the name of the custom command bar commandBarName = "cmb_CustomMenu" ' Name of the custom command bar ' Delete the existing command bar with the same name, if any CommandBars(commandBarName).Delete If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(commandBarName, BAR_TYPE_POPUP, False, False) With commandBar ' Add Cut button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 21, , , False) ' Button caption >>--> Cut commandButton.Caption = ChrW(1602) & ChrW(1589) commandButton.FaceId = 21 ' Icon for the Cut button ' Add Copy button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 19, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly ' Button caption >>--> Copy commandButton.Caption = ChrW(1606) & ChrW(1587) & ChrW(1582) commandButton.FaceId = 19 ' Icon for the Copy button ' Add Paste button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 22, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly ' Button caption >>--> Paste commandButton.Caption = ChrW(1604) & ChrW(1589) & ChrW(1602) commandButton.FaceId = 22 ' Icon for the Paste button ' Add Sort Ascending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 210, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons ' Button caption >>--> Sort Ascending commandButton.Caption = ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1589) & ChrW(1575) & ChrW(1593) & ChrW(1583) & ChrW(1610) commandButton.FaceId = 210 ' Icon for the Sort Ascending button ' Add Sort Descending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 211, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons ' Button caption >>--> Sort Descending commandButton.Caption = ChrW(1578) & ChrW(1585) & ChrW(1578) & ChrW(1610) & ChrW(1576) & ChrW(32) & ChrW(1578) & ChrW(1606) & ChrW(1575) & ChrW(1586) & ChrW(1604) & ChrW(1610) commandButton.FaceId = 211 ' Icon for the Sort Descending button ' Add Close Form/Report button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 923, , , False) ' Updated to False commandButton.BeginGroup = True ' Start a new group ' Button caption >>--> Close commandButton.Caption = ChrW(1573) & ChrW(1594) & ChrW(1604) & ChrW(1575) & ChrW(1602) commandButton.OnAction = "CloseCurrentItem" ' Call the CloseCurrentItem subroutine End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing End Sub ' Subroutine to close the currently active form or report Public Sub CloseCurrentItem() ' Ignore errors if no form or report is open ' On Error Resume Next Dim obj As Object ' Close the active form if it exists For Each obj In Forms If obj.Name = Screen.ActiveForm.Name Then DoCmd.Close acForm, obj.Name Exit Sub End If Next obj ' Close the active report if it exists For Each obj In Reports If obj.Name = Screen.ActiveReport.Name Then DoCmd.Close acReport, obj.Name Exit Sub End If Next obj ' If no form or report is active, show a message MsgBox "There is no active form or report to close.", vbExclamation ' Clean up Err.Clear End Sub Converter Arabic and Unicode (v. 3).accdb

اتفضل يا استاذ يوسف Option Compare Database Option Explicit ' Constants for button states and control types Public Const BUTTON_STATE_DOWN As Integer = -1 ' BUTTON_STATE_DOWN: Represents the state where a button is pressed down or activated. ' Used to indicate that a button is in the pressed state. Public Const BUTTON_STATE_UP As Integer = 0 ' BUTTON_STATE_UP: Represents the state where a button is in its normal (not pressed) state. ' Used to indicate that a button is not pressed or activated. 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. Public Const CONTROL_TYPE_EDIT As Integer = 2 ' CONTROL_TYPE_EDIT: Represents an edit control type, such as a text box. ' Typically 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 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 new command bar that behaves as a popup menu (i.e., appears on right-click or when invoked). ' Variables for CommandBar and Controls Public commandBar As Object ' Represents the custom command bar (popup menu) Public commandButton As Object ' Represents each button/control added to the command bar Public commandBarName As String ' Name of the custom command bar ' Subroutine to create and configure the custom command bar Public Sub CreateCustomCommandBar() ' Ignore errors during creation or deletion of the command bar On Error Resume Next ' Define the name of the custom command bar commandBarName = "cmb_CustomMenu" ' Name of the custom command bar ' Delete the existing command bar with the same name, if any CommandBars(commandBarName).Delete If Err.Number <> 0 Then Err.Clear ' Add a new command bar (popup menu) with the specified name Set commandBar = CommandBars.Add(commandBarName, BAR_TYPE_POPUP, False, False) With commandBar ' Add Cut button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 21, , , False) commandButton.Caption = "قص" ' Button caption commandButton.FaceId = 21 ' Icon for the Cut button ' Add Copy button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 19, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly commandButton.Caption = "نسخ" ' Button caption commandButton.FaceId = 19 ' Icon for the Copy button ' Add Paste button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 22, , , False) commandButton.BeginGroup = False ' Ensure items are grouped properly commandButton.Caption = "لصق" ' Button caption commandButton.FaceId = 22 ' Icon for the Paste button ' Add Sort Ascending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 210, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons commandButton.Caption = "ترتيب تصاعدي" ' Button caption commandButton.FaceId = 210 ' Icon for the Sort Ascending button ' Add Sort Descending button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 211, , , False) commandButton.BeginGroup = True ' Start a new group for sorting buttons commandButton.Caption = "ترتيب تنازلي" ' Button caption commandButton.FaceId = 211 ' Icon for the Sort Descending button ' Add Close Form/Report button Set commandButton = .Controls.Add(CONTROL_TYPE_BUTTON, 923, , , False) ' Updated to False commandButton.BeginGroup = True ' Start a new group commandButton.Caption = "إغلاق" ' Button caption commandButton.OnAction = "CloseCurrentItem" ' Call the CloseCurrentItem subroutine End With ' Clean up Set commandBar = Nothing Set commandButton = Nothing End Sub ' Subroutine to close the currently active form or report Public Sub CloseCurrentItem() ' Ignore errors if no form or report is open ' On Error Resume Next Dim obj As Object ' Close the active form if it exists For Each obj In Forms If obj.Name = Screen.ActiveForm.Name Then DoCmd.Close acForm, obj.Name Exit Sub End If Next obj ' Close the active report if it exists For Each obj In Reports If obj.Name = Screen.ActiveReport.Name Then DoCmd.Close acReport, obj.Name Exit Sub End If Next obj ' If no form or report is active, show a message MsgBox "There is no active form or report to close.", vbExclamation ' Clean up Err.Clear End Sub بخصوص الفاصل غير القيمة البولينية من false الى true فقط فى السطر الذى تريده لعمل الفاصل بين الاوامر فى قائمة السياق commandButton.BeginGroup = False ' Group items under this button من محرر الاوامر للمرة الاولى اعمل Run للدالة : CreateCustomCommandBar وفى النموذج خلى ShortcutMenuBar = cmb_CustomMenu

شوف هذا راى ولك طبعا مطلق الحرية انا عن نفسى افضل استخدام اسماء الجدول بالطريقة الاتية tblOfficenaForms ممكن حد تانى يحبها كده tbl_Officena_Forms انا وضعت دالة لتحويل اول حرف من كل مفطع الى حرف كبير وباقى الاحرف صغيرة وترطت للمستخدم حرية الاختيار فى موضوع ال Under Score وطبعا انا اسف انا غلط فى كتابتها على النموذج بالشكل Use ChkUnder Score لانها مفروض كانت تكون Use Under Score و\بعا جمبها او تحتها تلميح لتوضيح الوظيفة بس وقتها كنت خلاص رايح الشغل وضيق وقتى خلانى اقع فى المشكلة الالولى اللى اظهرت الرسائل مع اكثر من حقل طبعا انا اول التعديل كتبت الكود بصراحة ان تكون النتيجة بالشكل التالى tblOfficenaForms وبعدين فلت ليه افرض رأى فى الكود ولذلك فكرت فى استخدام Optional علشان اسيب للجميع حرية الاختيار وعدلت الكود تانى على هذا الاساس لاحظ كده فى الفترى الاخيرة تحديدا كل ما اقدمه احاول بقدر الامكان تحقيقة باكبر قدر ممكن من المرونه حتى وان تطلب هذا جهدا فى التفكير وانشاء وترتيب الافكار فى الكود وان ذادت اسطر الكود لا ابالى شوفت مرفق لعبة الكلمات المتقاطعة ؟ من هنا كنت عاملة بسيط من زمان جدا جدا على سبيل التسلية وقتها ولم اكمل العمل ولكن بعد مشاهدتى لموضوع الاستاذ @Moosak صحى الطفل اللى جوايا وذكريات الماضى لانه كنت و والدى رحمه الله تعال وكل المسلمين يوميا نلعبها فى الجرائد ونلعب ونضخك وقت الافطار بعد صلاة الفجر و وقت الشروق ولكن بصراحة لانه احبه جدا فى لله قلت اعاكسة ويلا بقى تحدى.... طبعا امزح انه اخى الحبيب ولكن انا تعلمت الكثر بسبب فقط عاصفة الافكار التى اجتاحتنى وقتها

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

سوف اقدم اليك النصح وانا اقل طويلب علم بالمنتدى ضع نصب عينيك دائما وابدا وبوجه خاص مع الاكسس البساطة قدر الامكان لانه صدقنى وعندما تكون البيانات اولا قليلة او قد يتتطلب مشروعك عمل وتنفيذ الكثير من الاجراءات وبالاخص ان كانت معقدة وام تم التعامل مع جهاز ضعيف او عبر استخدام القاعدة ضمن شبكة محلية قد تصيبك صدمة من استخدام ما قد يكون لو تأثير بالسلب على اداء وسرعة فاعدة البيانات لذلك انصحك بالبساطة اعلم انه فد ترى وتشاهد حركات وامور تكون مبهجة وقد تعجب بها جدا ولكن كما اخبرتك واليك مثال على الرئيسية على سبيل المثال expand and collapse button V3.zip

اخى الحبيب يا رعاك الله والله لم اقصد تقليلا او كبرا حاشى لله انا عن نفسى كنت استخدم التاج وذات مره استخدمت الـ StatusBarText ووقتها لم اكن اعرف هذه المعلومة لانه حاولت استخدام التاح فى وظيفة وهذه الخاصية اردت استخدامها بتوظيفها واستغلالها فى وظيفة أخرى ولم اكن اعلم ان الوصف يظهر فيها ومن خلالها وعرفتها قدرا بمحض الصدفة من استاذى الجليل و والدى الحبيب ومعلمى القدير الاستاذ @jjafferr ولان الشئ بالشئ يذكر تذكرت كلمات والدى الحبيب ومعلمى الجليل فأحببت فقط التنويه عنها ليعلم عنها احبابى واخوانى لا اكثر ولا اقل فقك اثراء للموضوع وزيادة فى المعرفة لمن لا يعلم عنها كما كان حالى وقتها ختى لا يقع بنفس المشكلة التى كدت ان اقع فيها بدون علم ولم ولن تكن لتخطر على بالى اما بالنسبة لـ ومن انا ومن اكون لأسمح أو اعترض القاعدة لكم والمنتدى كذلك انا طويلب علم وزائر الفجر ولا احاول فقط الا نشر العلم وتقديم ما املك من فضل الله تعالى فهو اولا صدقة جارية عن اساتذتى الذين اتعلم منهم وهكذا احتسبة وأتمنى على الله تعالى ان يكون فى موازين اعمالى يوم العرض جزاكم الله خيـرا