Saturday, April 14, 2012

Add a New menu on Mouse right click for workbook Navigation

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




11 comments:

  1. 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....

    This is just suggestion.. I learned lot from ur blog....... Keep posting...

    ReplyDelete
  2. Ashish i copied both work book and work sheet modules to personal.xlsm but i didnt getting navigation on right click. help me

    ReplyDelete
  3. can you share the workbook my id is koul.ashish@gmail.com

    ReplyDelete
  4. Excellent 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
  5. @ Raegle - I use online websites to make gifs like

    http://picasion.com/
    http://www.createagif.net/
    http://makeagif.com/
    http://gifup.com/

    ReplyDelete
  6. http://creativetechs.com/tipsblog/build-animated-gifs-in-photoshop/

    ReplyDelete
  7. Also Visit
    http://www.excelvbamacros.com/2012/08/add-new-button-on-mouse-right-click.html

    ReplyDelete
  8. Awesome piece of code. Greatly appreciated tks

    ReplyDelete
  9. now here is a question, just to be fuzzy. Is it possible to add the menu at the top of the Right Click CommandBar?

    ReplyDelete
  10. Aghh I have managed to add in the position via the "Before:=msoBarTop" section of code in the add_new_button.

    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, 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???

    ReplyDelete

Import data from SQL

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