كود انشاء toolbar

أبو امين · مايو 28, 2022

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

اريد كود انشاء toolbar اي الشاشة التي تظهر عند الضغط على زر الماوس الايمن مثلما هو مبين بالصورة اسفله و قد ارفقت مثالا للعمل عليه Image1.png.74aef1945ee1bd81ee2483ee6b922ac7.png

المثال.rar

**Barna** · مايو 28, 2022

تفضل شاهد هذا الموضوع

في 1‏/1‏/2020 at 22:56, jjafferr said:
السلام عليكم 🙂

هناك الكثير من الميزات/الاوامر التي يعطينا برنامج الاكسس ، والتي يمكن ان نعمل لها بديل ، ولكن يكون هناك فرق في سرعة تنفيذ كودنا مقارنة مع الكود الاصل من الاكسس !!

مثل القائمة المختصرة التي تظهر لنا بالنقر على زر الفأرة الايمن ، والتي بها يمكننا ان نستغني عن الكثير الاوامر ، مثل الفرز والتصفية بأنواعه ،

ولكن وللأسف الشديد ، فأنا ارى ان 99.99% من البرامج ، يتم حذف هذه القائمة وعدم تفعيلها ، والسبب ان المستخدم يستطيع ان يدخل في تصميم النموذج من خلال هذه الاوامر(في الدائرة الحمراء) :

و

.

ويضطر المبرمج ان يعوض بقية الاوامر في القائمة ، بمجموعة من الازرار ، او بطرق مختلفة !!

-----------------------------------------------------------------------------------------------

الاكسس يسمح لنا ان نعمل قوائم مختصرة Shortcut Menu والتابعة لمجموعة CommandBars ، حسب احتياجنا ، ونختار ما نضعه فيها 🙂

هناك 3 انواع من هذه القوائم :

الثابته ، والمؤقته ، والمؤقته التي تحتاج الى كود.

الثابته:

وهي التي عندما نعملها ، تصبح مستقله عن الكود ، وتُحفظ وتبقى في قاعدة البيانات بعد إغلاقها ، ويمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى ، بإستخدام :

.

ونختارها في النموذج :

.

او التقرير :

.

هذا مثال لعمل الكود الاساس لعمل قائمة قطع/نسخ/لصق :
Option Compare Database
Option Explicit

    Dim cmb As Object
    Dim cmbCtrl As Object
    Dim cmbName As String
'

'
' to use:
' Dim cbr As Commandbar
' Dim cbrButton as CommandbarControl
'
' we have to select in the References:
' Microsoft Office xx.x Object Library
'


Public Function SCM_Copy(Optional DeleteMe As Boolean = False)
    
    On Error Resume Next 'If menu with same name exists delete
    cmbName = "cmb_Copy"
    CommandBars(cmbName).Delete
    If DeleteMe = True Then Exit Function
    If Err.Number <> 0 Then Err.Clear
    
    Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False)
    
        With cmb
          .Controls.Add msoControlButton, 21, , , False   ' Cut
          .Controls.Add msoControlButton, 19, , , False   ' Copy
          .Controls.Add msoControlButton, 22, , , False   ' Paste
      End With
      
  Set cmb = Nothing
    
End Function
.

وشرح الكود :

1. اسم القائمة المختصرة ، والتي سوف نختارها في النموذج او التقرير ،

2. هذه المجموعة الاساس منبثقة Popup ،

3. بينما هذه المجموعات عبارة عن ازرار Buttons ، وقد تكون قائمة منسدلة Combobox ، او نص Edit نُدخل فيه قيمة معينة للتصفية مثلا ،

4. هل هذه القائمة مؤقته ؟ False معناها ثابته وتُحفظ في قاعدة البيانات ، بينما True معناها انها مؤقته وتعمل لما ننادي الوحدة النمطية/الكود ،

5. هذه ارقام كل امر ، وملف الاكسل المرفق من مايكروسوفت فيه جدول يضم جميع ارقام الاوامر للاكسس 2010 () ،

6. اذا اردنا ان نحذف هذه القائمة ، فننادي الوحدة النمطية بضم True في امر المناداة

المؤقته: ونستعمل True في مكان الرقم 4 اعلاه.

وهي التي عندما نعملها ، لا تصبح مستقله عن الكود ، ولا تبقى في قاعدة البيانات بعد إغلاقها ، ولا يمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى (كما هو الحال مع القائمة الثابته) ، ويجب ان نستخدم "حدث فتح" النموذج/التقرير لعملها واستخدامها في النموذج/التقرير ، و "حدث اغلاق" النموذج/التقرير لحذفها ،

طيب ، خلونا نعمل هذه القائمة :
Public Function SCM_Copy_Sort(Optional DeleteMe As Boolean = False)

    On Error Resume Next 'If menu with same name exists delete
    cmbName = "cmb_Copy_Sort"
    CommandBars(cmbName).Delete
    If Err.Number <> 0 Then Err.Clear
    
    Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False)
    
        With cmb
            Set cmbCtrl = .Controls.Add(msoControlButton, 21, , , False)    ' Cut
                cmbCtrl.Caption = "Cut..."
                cmbCtrl.FaceId = 21
            
            Set cmbCtrl = .Controls.Add(msoControlButton, 19, , , False)    ' Copy
                cmbCtrl.Caption = "Copy..."
                cmbCtrl.FaceId = 19
            
            Set cmbCtrl = .Controls.Add(msoControlButton, 22, , , False)    ' Paste
                cmbCtrl.Caption = "Paste..."
                cmbCtrl.FaceId = 22
                
                
            Set cmbCtrl = .Controls.Add(msoControlButton, 210, , , False)  'Sort Ascending
                cmbCtrl.BeginGroup = True
                cmbCtrl.Caption = "فرز تصاعدي..."
                cmbCtrl.FaceId = 210
                
            Set cmbCtrl = .Controls.Add(msoControlButton, 211, , , False)  'Sort Decending
                cmbCtrl.Caption = "فرز تنازلي..."
                cmbCtrl.FaceId = 211

      End With
  Set cmb = Nothing
    
End Function
.

وشرح الكود:

احنا توسعنا في الكود الاساسي ، واضفنا له :

1. تسمية اختيارية غير الافتراضية ، لاحظ في الصورة اعلاه اني استعملت الانجليزي والعربي ،

3. وهو لعمل خط فاصل في الصورة بين مجموعة قطع/نسخ/لصق ومجموعة فرز تصاعدي/تنازلي ،

.

2. ممكن ان نبدل الصورة الافتراضية التي تيجي مع الرقم ، بتبديل هذا الرقم (لاحظ صورة الاسهم للتصاعدي/التنازلي) :

.

ومرفق ارقام جميع الصور الموجودة في الاكسس :

.

.

.

.

.

.

.

.

.

.

.

في قاعدة البيانات المرفقة myRight_Click.mdb ، بالاضافة الى القوائم الثابته اعلاه ، تم اضافة هذه القائمة ايضا :

.

والتقرير يحتوي على القائمة المؤقته التالية :

.

- ملف الاكسل myList.xlsx ، اخترت فيه اهم القوائم في وجهة نظري ،

- ملف الاكسل AccessControls_2010.xlsx ، من مايكروسوفت ، يحتوي على جميع الاوامر 🙂

جعفر

المصادر:

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

AccessControls_2010.xlsx 88.33 kB · 240 downloads

myList.xlsx 24.25 kB · 198 downloads

myRight_Click.zip 53.24 kB · 354 downloads