将macros添加到右键菜单

我想添加一个创build的macros到右键菜单。 可能吗？

非常感谢！

Answer 1

如果你的意思是添加一个macros，当你右键点击你的鼠标，然后你可以尝试这个代码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上find