THISWORKBOOK (paste into ThisWorkbook, macros that open and closed menus when launching and closing spreadsheet)

Private Sub Workbook_Open()

MsgBox "You can right-click any worksheet cell" & vbCrLf & _

"to see and / or run your workbook's macros.", 64, "A tip:"

Run "RightClickReset"

Run "MakeMenu"

End Sub

Private Sub Workbook_Activate()

Run "RightClickReset"

Run "MakeMenu"

End Sub

Private Sub Workbook_Deactivate()

Run "RightClickReset"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Run "RightClickReset"

ThisWorkbook.Save

End Sub

'DEMONSTRATIONMACROS (paste into module DemonstrationMacros, macros you want to launch from the custom menu, these are examples)

Sub Macro1()

MsgBox "This is Macro1.", 64, "Test 1"

End Sub

Private Sub Macro2()

MsgBox "This is Macro2.", 64, "Test 2"

End Sub

Sub Macro3()

MsgBox "This is Macro3.", 64, "Test 3"

End Sub

'MAINTENANCEMACROS (paste into module MaintenanceMacros, macros for creation and running of custom menu)

Private Sub RightClickReset()

On Error Resume Next

CommandBars("Cell").Controls("Macro List").Delete

Err.Clear

CommandBars("Cell").Reset

End Sub

Private Sub MakeMenu()

Run "RightClickReset"

Dim objCntr As CommandBarControl, objBtn As CommandBarButton

Dim strMacroName$

Set objCntr = _

Application.CommandBars("Cell").Controls.Add(msoControlPopup, before:=1)

objCntr.Caption = "Macro List"

Application.CommandBars("Cell").Controls(2).BeginGroup = True

Dim intLine%, intArgumentStart%, strLine$, objComponent As Object

For Each objComponent In ActiveWorkbook.VBProject.VBComponents

If objComponent.Type = 1 Then

For intLine = 1 To objComponent.CodeModule.CountOfLines

strLine = objComponent.CodeModule.Lines(intLine, 1)

strLine = Trim$(strLine) 'Remove indented spaces

If Left$(strLine, 3) = "Sub" Or Left$(strLine, 11) = "Private Sub" Then

intArgumentStart = InStr(strLine, "()")

If intArgumentStart > 0 Then

If Left$(strLine, 3) = "Sub" Then

strMacroName = Trim(Mid$(strLine, 4, intArgumentStart - 4))

Else

strMacroName = Trim(Mid$(strLine, 12, intArgumentStart - 12))

End If

If strMacroName <> "RightClickReset" And strMacroName <> "MakeMenu" Then

If strMacroName <> "MacroChosen" Then

Set objBtn = objCntr.Controls.Add

With objBtn

.Caption = strMacroName

.Style = msoButtonIconAndCaption

.OnAction = "MacroChosen"

.FaceId = 643

End With

End If

End If

End If

End If

Next intLine

End If

Next objComponent

End Sub

Private Sub MacroChosen()

With Application

Run .CommandBars("Cell").Controls(1).Controls(.Caller(1)).Caption

End With

End Sub