Advanced Search

Excel (VBA) Custom right-click menu to launch macros

/ Published in: Visual Basic
Save to your folder(s)
Create a custom right-click menu that will list and launch all macros in the DemonstationMacros module. Copy and past the code into the relevant object or module.

Expand | Embed | Plain Text

Copy this code and paste it in your HTML 
  1. 'THISWORKBOOK (paste into ThisWorkbook, macros that open and closed menus when launching and closing spreadsheet)
  2.  
  3. Private Sub Workbook_Open()
  4. MsgBox "You can right-click any worksheet cell" & vbCrLf & _
  5. "to see and / or run your workbook's macros.", 64, "A tip:"
  6. Run "RightClickReset"
  7. Run "MakeMenu"
  8. End Sub
  9.  
  10. Private Sub Workbook_Activate()
  11. Run "RightClickReset"
  12. Run "MakeMenu"
  13. End Sub
  14.  
  15. Private Sub Workbook_Deactivate()
  16. Run "RightClickReset"
  17. End Sub
  18.  
  19. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  20. Run "RightClickReset"
  21. ThisWorkbook.Save
  22. End Sub
  23.  
  24. 'DEMONSTRATIONMACROS (paste into module DemonstrationMacros, macros you want to launch from the custom menu, these are examples)
  25.  
  26. Sub Macro1()
  27. MsgBox "This is Macro1.", 64, "Test 1"
  28. End Sub
  29.  
  30. Private Sub Macro2()
  31. MsgBox "This is Macro2.", 64, "Test 2"
  32. End Sub
  33.  
  34. Sub Macro3()
  35. MsgBox "This is Macro3.", 64, "Test 3"
  36. End Sub
  37.  
  38. 'MAINTENANCEMACROS (paste into module MaintenanceMacros, macros for creation and running of custom menu)
  39.  
  40. Private Sub RightClickReset()
  41. On Error Resume Next
  42. CommandBars("Cell").Controls("Macro List").Delete
  43. Err.Clear
  44. CommandBars("Cell").Reset
  45. End Sub
  46.  
  47. Private Sub MakeMenu()
  48. Run "RightClickReset"
  49. Dim objCntr As CommandBarControl, objBtn As CommandBarButton
  50. Dim strMacroName$
  51. Set objCntr = _
  52. Application.CommandBars("Cell").Controls.Add(msoControlPopup, before:=1)
  53. objCntr.Caption = "Macro List"
  54. Application.CommandBars("Cell").Controls(2).BeginGroup = True
  55. Dim intLine%, intArgumentStart%, strLine$, objComponent As Object
  56. For Each objComponent In ActiveWorkbook.VBProject.VBComponents
  57. If objComponent.Type = 1 Then
  58. For intLine = 1 To objComponent.CodeModule.CountOfLines
  59. strLine = objComponent.CodeModule.Lines(intLine, 1)
  60. strLine = Trim$(strLine) 'Remove indented spaces
  61. If Left$(strLine, 3) = "Sub" Or Left$(strLine, 11) = "Private Sub" Then
  62. intArgumentStart = InStr(strLine, "()")
  63. If intArgumentStart > 0 Then
  64. If Left$(strLine, 3) = "Sub" Then
  65. strMacroName = Trim(Mid$(strLine, 4, intArgumentStart - 4))
  66. Else
  67. strMacroName = Trim(Mid$(strLine, 12, intArgumentStart - 12))
  68. End If
  69. If strMacroName <> "RightClickReset" And strMacroName <> "MakeMenu" Then
  70. If strMacroName <> "MacroChosen" Then
  71. Set objBtn = objCntr.Controls.Add
  72. With objBtn
  73. .Caption = strMacroName
  74. .Style = msoButtonIconAndCaption
  75. .OnAction = "MacroChosen"
  76. .FaceId = 643
  77. End With
  78. End If
  79. End If
  80. End If
  81. End If
  82. Next intLine
  83. End If
  84. Next objComponent
  85. End Sub
  86.  
  87. Private Sub MacroChosen()
  88. With Application
  89. Run .CommandBars("Cell").Controls(1).Controls(.Caller(1)).Caption
  90. End With
  91. End Sub

URL: http://www.atlaspm.com/toms-tutorials-for-excel/toms-tutorials-for-excel-customizing-your-rightclick-menu-to-list-run-macros/

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.