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 in ThisWorkbook
And the code in the MenuSheet (Which is Sheet1)
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!
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!