RDB: QAT ShortCut Macro Menu

ajay_gajree

Well-known Member
Joined
Jul 16, 2011
Messages
518
Hi All

I have implemented Ron De Bruins QAT Menu for personal macros

Menu for favorite macros in Excel 2007-2010 (for all workbooks)

I want to add a 2nd one but I am having trouble adapting the code, I am able to get two different dropdowns onto the QAT, but when I edit the menu (Bottom Command on the drop down) it will not refer to the 2nd Button's Add in, it goes to the first one.

So the code


RDBMenuCode Module in a Standard Module is

Code:
Option Explicit
Option Private Module
'See this page for more info
'http://www.rondebruin.nl/qat.htm
'TIP:
'After you click on "Edit Menu" in the menu you can change the button image.
'Right click on the QAT and choose Customize Quick Access Toolbar.
'In the “Choose commands from” dropdown choose Macros and in the
'Customize Quick Access Toolbar dropdown choose "For My Add-in.xlam".
'Select the RDBDisplayPopUp macro and press the Modify button to change the icon.

Sub WBCreatePopUp()
    Dim MenuSheet As Worksheet
    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim row As Integer
    Dim MenuLevel, NextLevel, MacroName, Caption, Divider, FaceId
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    '   Location for menu data
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    '   Make sure the menus aren't duplicated
    Call WBRemovePopUp
    '   Initialize the row counter
    row = 5
    '   Add the menu, menu items and submenu items using
    '   data stored on MenuSheet
    ' First we create a PopUp menu with the name of the value in B2
    With Application.CommandBars.Add(ThisWorkbook.Sheets("MenuSheet"). _
                                     Range("B2").Value, msoBarPopup, False, True)
        Do Until IsEmpty(MenuSheet.Cells(row, 1))
            With MenuSheet
                MenuLevel = .Cells(row, 1)
                Caption = .Cells(row, 2)
                MacroName = .Cells(row, 3)
                Divider = .Cells(row, 4)
                FaceId = .Cells(row, 5)
                NextLevel = .Cells(row + 1, 1)
            End With
            Select Case MenuLevel
            Case 2    ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = .Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = .Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                End If
                MenuItem.Caption = Caption
                If FaceId <> "" Then MenuItem.FaceId = FaceId
                If Divider Then MenuItem.BeginGroup = True
            Case 3    ' A SubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                If FaceId <> "" Then SubMenuItem.FaceId = FaceId
                If Divider Then SubMenuItem.BeginGroup = True
            End Select
            row = row + 1
        Loop
    End With
End Sub
Sub RDBDisplayPopUp()
    On Error Resume Next
    Application.CommandBars(ThisWorkbook.Sheets("MenuSheet").Range("B2").Value).ShowPopup
    On Error GoTo 0
End Sub
Sub EditMenu()
    ThisWorkbook.IsAddin = False
End Sub
Sub WBRemovePopUp()
    On Error Resume Next
    Application.CommandBars(ThisWorkbook.Sheets("MenuSheet").Range("B2").Value).Delete
    On Error GoTo 0
End Sub


Code in ThisWorkbook

Code:
Option Explicit
Private Sub Workbook_Open()
    Call WBCreatePopUp
End Sub


And the code in the MenuSheet (Which is Sheet1)

Code:
Option Explicit
Private Sub CommandButton1_Click()
    Call WBCreatePopUp
    MsgBox "Click on the button in the QAT to see if your menu is correct.", vbOKOnly, "Favorite Macro Menu"
End Sub
Private Sub CommandButton2_Click()
    Call WBCreatePopUp
    Range("A1").Select
    ThisWorkbook.IsAddin = True
    ThisWorkbook.Save
End Sub
Private Sub CommandButton3_Click()
    ThisWorkbook.IsAddin = True
    ThisWorkbook.Saved = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Step 1:  Declare Variables
    Dim strRange As String
'Step2:  Build the range string
    strRange = Target.Cells.Address & "," & _
               Target.Cells.EntireColumn.Address & "," & _
               Target.Cells.EntireRow.Address
'Step 3: Pass the range string to a Range
    Range(strRange).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address
End Sub

I hope that is clear, it is a lot of code and I may not have explained it very well :(

Pointers appreciated as always!

What I want to do, is create a series of these for like minded macros, so I can distribute to other people just the parts they want.

So one for say Email Macros, One for Printing Macros, One for Formatting, etc

This would be easier than having it all on one and it seeming too busy!
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top