If you want to add a new button on mouse right click menu "Worksheet Navigation" showing the list of worksheets in active workbook. Snapshot below -
Here is the code-
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 "New Button"
Application.CommandBars("Cell" ).Controls("Worksheet 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 "New Button"
Application.CommandBars("Cell" ).Controls("Worksheet 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 "New Button"
Dim cBut As CommandBarControl
On Error Resume Next
' name of the new button "New Button"
Application.CommandBars("Cell" ).Controls("Worksheet Navigation").Delete
Set cBut = Application.CommandBars("Cell" ).Controls.Add(Type:= msoControlPopup, Temporary:=True)
' name of the new button is "New Button"
cBut.Caption = "Worksheet 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 cbut2 As CommandBarControl
Dim cmda As CommandBarControl
Dim i As Integer
Dim wk As Worksheet
' delete all exisitng buttons if any added on "New Button" Further"
For Each cmda In Application.CommandBars("Cell" ).Controls("Worksheet Navigation").Controls
On Error Resume Next
cmda.Delete
Next
' run a loop and add new buttons further on "New Button"
For Each wk In ActiveWorkbook.Sheets
Set cbut2 = Application.CommandBars("Cell" ).Controls("Worksheet Navigation").Controls.Add( Type:=msoControlButton)
With cbut2
'button name
.Caption = wk.Name
' macro to be assigned on button
.OnAction = "activate_sheet"
If wk.Visible = True Then
.FaceId = 351
Else
.FaceId = 352
End If
End With
Next
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 File https://www.box.com/s/ 3ea936298495f621e4ad
No comments:
Post a Comment