If you want to add a new menu on mouse right click "Workbook Navigation showing you the list of all open workbooks and worksheets in each of these workbooks. So that you can navigate easily. Snapshot below-
Add below code to workbook open module
Private Sub Workbook_Open()
On Error Resume Next
'Delete the new button if already exists
' name of the new button is "Workbook Navigation"
Application.CommandBars("Cell" ).Controls("Workbook Navigation").Delete
'run a macro to add a new button on mouse right click
Call add_new_button
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
' delete the btton when workbook is closed.
' name of the new button is "Workbook Navigation"
Application.CommandBars("Cell" ).Controls("Workbook Navigation").Delete
End Sub
Add below code to module1 or any new module
Option Explicit
Sub add_new_button()
' macro to add new button with name "Workbook Navigation"
Dim cBut As CommandBarControl
On Error Resume Next
' name of the new button "Workbook Navigation"
Application.CommandBars("Cell" ).Controls("Workbook Navigation").Delete
Set cBut = Application.CommandBars("Cell" ).Controls.Add(Type:= msoControlPopup, Temporary:=True)
' name of the new button is "Workbook Navigation
cBut.Caption = "Workbook Navigation"
' name of macro which you want to run when u will click on it
cBut.OnAction = "new_button_macro"
End Sub
Sub new_button_macro()
Dim wk As Workbook
Dim wks As Worksheet
Dim cmda As CommandBarControl
Dim cbut2 As CommandBarControl, CBT3 As CommandBarControl
For Each cmda In Application.CommandBars("Cell" ).Controls("Workbook Navigation").Controls
On Error Resume Next
cmda.Delete
Next
For Each wk In Application.Workbooks
Set cbut2 = Application.CommandBars("Cell" ).Controls("Workbook Navigation").Controls.Add( Type:=msoControlPopup)
With cbut2
.Caption = wk.Name
.OnAction = "activate_workbook"
End With
For Each wks In wk.Sheets
Set CBT3 = cbut2.Controls.Add(Type:= msoControlButton)
With CBT3
.Caption = wks.Name
.OnAction = "activate_sheet"
If wks.Visible = True Then
.FaceId = 351
Else
.FaceId = 352
End If
End With
Next
Next
End Sub
Sub activate_workbook()
On Error Resume Next
Windows(Application. CommandBars.ActionControl. Caption).Activate
End Sub
Sub activate_sheet()
Dim ans As String
' check if sheet is hidden
If ActiveWorkbook.Sheets( Application.CommandBars. ActionControl.Caption).Visible <> xlSheetVisible Then
ans = MsgBox("This Worksheet is currently hidden. Do you want to unhide ? ", vbOKCancel, "Please Answer")
If ans = vbOK Then
ActiveWorkbook.Sheets( Application.CommandBars. ActionControl.Caption).Visible = True
ActiveWorkbook.Sheets( Application.CommandBars. ActionControl.Caption).Select
Else
Exit Sub
End If
Else
ActiveWorkbook.Sheets( Application.CommandBars. ActionControl.Caption). Activate
End If
End Sub
Download Working Macro https://www.box.com/s/ 6902c9af265ae67733fd
I suggest you to post some comments on each vba code which you write... this will help anyone to understand the code in deeper and also they can modify as per their requirement... and also comment 2 or 3 ways of doing similar activity....
ReplyDeleteThis is just suggestion.. I learned lot from ur blog....... Keep posting...
@Harry Thanks
ReplyDeleteAshish i copied both work book and work sheet modules to personal.xlsm but i didnt getting navigation on right click. help me
ReplyDeletecan you share the workbook my id is koul.ashish@gmail.com
ReplyDeleteExcellent Ashihs!! Fantastic. thanks for sharing with us. I need to create some GIF images for my project. Can you please tell me what is the one you are using? I beleive you can help me on this.
ReplyDelete@ Raegle - I use online websites to make gifs like
ReplyDeletehttp://picasion.com/
http://www.createagif.net/
http://makeagif.com/
http://gifup.com/
http://creativetechs.com/tipsblog/build-animated-gifs-in-photoshop/
ReplyDeleteAlso Visit
ReplyDeletehttp://www.excelvbamacros.com/2012/08/add-new-button-on-mouse-right-click.html
Awesome piece of code. Greatly appreciated tks
ReplyDeletenow here is a question, just to be fuzzy. Is it possible to add the menu at the top of the Right Click CommandBar?
ReplyDeleteAghh I have managed to add in the position via the "Before:=msoBarTop" section of code in the add_new_button.
ReplyDeleteSub add_new_button()
' macro to add new button with name "Workbook Navigation"
Dim cBut As CommandBarControl
On Error Resume Next
' name of the new button "Workbook Navigation"
Application.CommandBars("Cell").Controls("Workbook Navigation").Delete
Set cBut = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Before:=msoBarTop, Temporary:=True)
' name of the new button is "Workbook Navigation
cBut.Caption = "Workbook Navigation"
' name of macro which you want to run when u will click on it
cBut.OnAction = "new_button_macro"
End Sub
WHY? well it saves me scrolling to the botton of the menu bar, sorry I'm lazy al that scrolling would save 30 seconds a day in work!!!
Again the most useful VBA code I've ever had. How did I live without it???