Friday, August 24, 2012

Add Worksheet Navigation button on mouse right click

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






No comments:

Post a Comment

Import data from SQL

Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...