Добавить макрос в контекстное меню

Question

Я хотел бы добавить созданный макрос в контекстное меню.Возможно ли это?

Большое спасибо!

Answer 1

Если вы имели в виду добавить макрос к опциям при щелчке правой кнопкой мыши, вы можете попробовать этот код CreateMacro , который присваивает Test_Macro меню правой кнопки мыши с заголовком YourCode .

Запустите KillMacro, чтобы удалить пункт меню

Const strMacro = "YourCode"

Sub CreateMacro()
   Dim cBut
   Call KillMacro
   Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
   With cBut
       .Caption = strMacro
       .Style = msoButtonCaption
       .OnAction = "Test_Macro"
   End With
End Sub

Sub Test_Macro()
   MsgBox "I work"
End Sub

Sub KillMacro()
   On Error Resume Next
   Application.CommandBars("Cell").Controls(strMacro).Delete
End Sub

Answer 2

Вот отличный кусок кода:

код для ThisWorkbook кодовый лист

Option Explicit 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 

     'remove our custom menu before we leave
    Run ("DeleteCustomMenu") 

End Sub 

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 

    Run ("DeleteCustomMenu") 'remove possible duplicates
    Run ("BuildCustomMenu") 'build new menu

End Sub 
 '### code for the ThisWorkbook code sheet - END

код для нового модуля

Option Explicit 

Private Sub BuildCustomMenu() 

    Dim ctrl As CommandBarControl 
    Dim btn As CommandBarControl 
    Dim i As Integer 

     'add a 'popup' control to the cell commandbar (menu)
    Set ctrl = Application.CommandBars("Cell").Controls.Add _ 
    (Type:=msoControlPopup, Before:=1) 
    ctrl.Caption = "Insert Shape..." 
     'add the submenus
    For i = 50 To 250 Step 50 'add a few menu items
        Set btn = ctrl.Controls.Add 
        btn.Caption = i & " x " & (i / 2) 'give them a name
        btn.Tag = i 'we'll use the tag property to hold a value
        btn.OnAction = "InsertShape" 'the routine called by the control
    Next 

End Sub 

Private Sub DeleteCustomMenu() 

    Dim ctrl As CommandBarControl 

     'go thru all the cell commandbar controls and delete our menu item
    For Each ctrl In Application.CommandBars("Cell").Controls 
        If ctrl.Caption = "Insert Shape..." Then ctrl.Delete 
    Next 

End Sub 

Private Sub InsertShape() 

    Dim t As Long 
    Dim shp As Shape 

     'get the tag property of the clicked control
    t = CLng(Application.CommandBars.ActionControl.Tag) 

     'use the value of t and the active cell as size and position parameters
     'for adding a rectangle to the worksheet
    Set shp = ActiveSheet.Shapes.AddShape _ 
    (msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, t, t / 2) 
     'do something with our shape
    Randomize 'make it a random color from the workbook
    shp.Fill.ForeColor.SchemeColor = Int((56 - 1 + 1) * Rnd + 1) 

End Sub 
 '### code for a new module - END

Найдено на VBAExpress