/build/static/layout/Breadcrumb_cap_w.png

Add a New menu on Mouse right for workbook Navigation

If you want to add a new menu on mouse right click showing you the list of all open workbooks and worksheets in each of these workbooks. So that you can navigate easily. Snapshot below-


\


The code given below  will add a new menu on right click mouse "Browse Workbook". When you will click on it it will show you the list of all open workbooks and worksheets in each workbook . 

Add this to workbook Module

Private Sub Workbook_Open()
On Error Resume Next
Application.CommandBars("Cell").Controls("Browse Workbooks").Delete
Call CREATE_MENU_my_menu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Controls("Browse Workbooks").Delete
End Sub


Add this code to module1 or in any new module 


Option Explicit
Sub CREATE_MENU_my_menu()
On Error GoTo abc:
Dim cBut As CommandBarControl
On Error Resume Next
Application.CommandBars("Cell").Controls("Browse Workbooks").Delete
Set cBut = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True)
cBut.Caption = "Browse Workbooks"
cBut.OnAction = "add_controls_my_menu"
abc:
Exit Sub
End Sub

Sub add_controls_my_menu()
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("Browse Workbooks").Controls
On Error Resume Next
cmda.Delete
Next
For Each wk In Application.Workbooks
Set cbut2 = Application.CommandBars("Cell").Controls("Browse Workbooks").Controls.Add(Type:=msoControlPopup)
With cbut2
.Caption = wk.Name
.OnAction = "my_menu_activate_workbook"
End With
For Each wks In wk.Sheets
If wks.Visible = xlSheetVisible Then
Set CBT3 = cbut2.Controls.Add(Type:=msoControlButton)
With CBT3
.Caption = wks.Name
.OnAction = "my_menu_activate_WORKSHEET"
End With
End If
Next
Next
End Sub



Sub my_menu_activate_workbook()
On Error Resume Next
Windows(Application.CommandBars.ActionControl.Caption).Activate
End Sub

Sub my_menu_activate_WORKSHEET()
On Error Resume Next
Sheets(Application.CommandBars.ActionControl.Caption).Activate
End Sub


Comments

This post is locked
 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ