السلام عليكم ورحمة الله وبركاته

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


الشرح داخل الملف بالتفصيل لتتمكن من التعديل على الكود بما يتناسب مع احتياجاتك

إليكم الكود الذي يوضع في موديول عادي

'الإعلان عن ثابت يحمل النص بين الأقواس ، وهو عبارة عن اسم القائمة المخصصة
Public Const mName As String = "MyPopUpMenu"

Sub DeletePopUpMenu()
'في هذا الإجراء يتم حذف القائمة المخصصة ، ووضع السطرين لتفادي حدوث خطأ
'---------------------------------------------------------------------
    On Error Resume Next
        Application.CommandBars(mName).Delete
    On Error GoTo 0
End Sub

Sub CreateDisplayPopUpMenu()
'إنشاء القائمة المخصصة ثم إظهارها
'--------------------------------
    'استدعاء الإجراء لحذف القائمة أولاً
    Call DeletePopUpMenu

    'استدعاء الإجراء لإنشاء القائمة المخصصة
    Call Custom_PopUpMenu_1

    '[MyPopUpMenu] إظهار القائمة المخصصة والمسماة
    On Error Resume Next
        Application.CommandBars(mName).ShowPopup
    On Error GoTo 0
End Sub

Private Sub Custom_PopUpMenu_1()
    '[MyPopUpMenu] بدء التعامل مع أشرطة الأدوات لإضافة شريط جديد بالاسم
    With Application.CommandBars.Add(Name:=mName, Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
        '** [Button1] إضافة عنصر للقائمة الجديدة باسم
        '--------------------------------------------
        'تقوم بتغيير الشكل المرتبط بالعنصر المضاف [FaceId] الخاصية المسماة
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Button 1"
            .FaceId = 71    'Change To 41 For Example
            
            'هذا السطر هام جداً وهو المسئول عن ربط العنصر بإجراء معين أو ماكرو
            'أي عندما نقوم بعمل كليك يمين ثم تظهر القائمة المخصصة الجديدة
            'ثم نختار العنصر من القائمة يتم تنفيذ ماكرو معين واسم الماكرو
            'يوضع بين أقواس تنصيص بعد الإشارة إلى المصنف الذي يحوي الماكرو
            '['] وهو هنا المصنف الحالي أي اسم المصنف الحالي مسبوقاً ومتبوعاً بعلامة
            '[TestMacro1] ثم يليه علامة تعجب ثم اسم الماكرو الذي سيتم تنفيذه هنا
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro1"
        End With

        '** [Button2] إضافة عنصر للقائمة الجديدة باسم
        '--------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Button 2"
            .FaceId = 72
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro2"
        End With

        '** [My Special Menu] إضافة عنصر للقائمة الجديدة باسم
        '----------------------------------------------------
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "My Special Menu"
            
            '== [Button 2 In Menu] والآخر باسم [Button 1 In Menu] هنا يتم إنشاء أوامر فرعية للعنصر أحدهما باسم
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "Button 1 In Menu"
                .FaceId = 71
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacroSpecial1"
            End With

            With .Controls.Add(Type:=msoControlButton)
                .Caption = "Button 2 In Menu"
                .FaceId = 72
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacroSpecial2"
            End With
            '==--------------------------------------------------------------------------------------------==
        End With
        
        '** [Button3] إضافة عنصر للقائمة الجديدة باسم
        '--------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Button 3"
            .FaceId = 73
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro3"
        End With
    End With
End Sub

Sub TestMacro1()
    MsgBox "TestMacro1"
End Sub

Sub TestMacro2()
    MsgBox "TestMacro2"
End Sub

Sub TestMacroSpecial1()
    MsgBox "TestMacroSpecial1"
End Sub

Sub TestMacroSpecial2()
    MsgBox "TestMacroSpecial2"
End Sub

Sub TestMacro3()
    MsgBox "TestMacro3"
End Sub

وهذا الكود يوضع في حدث المصنف

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'يتم تنفيذ الكود المسئول عن إنشاء القائمة المخصصة إذا قمت بعمل كليك
'يمين في العمود الثالث في أي ورقة عمل من أوراق العمل الموجودة بالمصنف
'---------------------------------------------------------------------
    On Error Resume Next
        'إذا كان عمود الخلية الهدف التي يتم عمل كليك يمين فيها يساوي 3
        If Target.Column = 3 Then
        
            'يتم إلغاء قائمة الكليك يمين الافتراضية
            Cancel = True
    
            'استدعاء الكود الذي يقوم بإنشاء القائمة المخصصة
            Call CreateDisplayPopUpMenu
        End If
    On Error GoTo 0
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'يوضع هذا الكود في حدث المصنف ، بحيث يتم حذف القائمة المخصصة قبل إغلاق المصنف
'----------------------------------------------------------------------------
    Call DeletePopUpMenu
End Sub

كيفية التعامل مع الملف المرفق : تم وضع كود في حدث المصنف بحيث تظهر القائمة المنبثقة عند عمل كليك يمين في العمود الثالث أي العمود C في أي ورقة من أوراق العمل بالمصنف ، قم بالنقر على أي عنصر داخل القائمة لكي يتم تنفيذ الماكرو المرتبط بهذا العنصر.

وأخيراً إليكم الملف المرفق يحتوي على الأكواد مع الشرح


رابط الملف من هنا


إعداد / ياسر خليل أبو البراء