Add standard excel button to custom toolbar menu

G

Gixxer_J_97

Hi all,

i have the following code that creates my custom toolbar.
I would like to add some standard toolbar buttons to it, but am having
problems,

The buttons i want to add are:

Save
Print Preview
Print
Zoom
Center
Borders
Fill Color
Font Color

I tried to record a macro adding the buttons i wanted, but it gave me code
like:

Application.CommandBars("Custom Popup 942187").Controls.Add
Type:=msoControlSplitButtonPopup, ID:=401, before:=1

and this never worked when the code was run again - i'm thinking that
"Custom Popup 942187" is a temporary ID for the target menu.

I was thinking I could add these buttons to the "Workbook Tools" menu in the
With MenuItm
If Arr0(i) = "Wor&kbook Tools" Then
'.Type = Arr2(i)(j)
'.ID = Arr4(i)(j)
'.Style = Arr2(i)(j)
.FaceId = Arr4(i)(j)

Else

section - however when i try to set the .type and .id, i get a 'cannot set a
read only property' error.

any thoughts?

tia

J

Here is my code:

Public Sub CreateToolbar()
' create the custom toolbar for this application
' Arr0 contains the names of the buttons created
' Arr1 contains the tooltip text for the buttons in Arr0
' Arr0 - Arr5 must be the same dimensions 1xY
' Arr2 contains an array of arrays with the names of the submenu items
' Arr2 - Arr5 are accessed by Arr#(i)(j), where # is 2-4 and i is the
ith element in
' Arr2 and j is the jth element in the inner array.
' Arr3 contains the names of the macros that the corresponding elements
in Arr2 will
' refer to.
' Arr4 contains the FaceId of each element in Arr2 (ie the button image)
' Arr5 contains the tags of the buttons, used to determine which one was
called (in lieu of passing arguments)

' Pre-dimension all variables that will be used
Dim CBAR As CommandBar
Dim NewMenu As CommandBarControl, MenuItm As CommandBarButton,
SubMenuItm As CommandBarControl
Dim Arr0 As Variant, Arr1 As Variant, Arr2 As Variant, Arr3 As Variant,
Arr4 As Variant, Arr5 As Variant, Arr6 As Variant
Dim i As Integer, j As Integer, widths As Integer
Dim MenuName As String

' Define the menu name - flexibility to change the name only in one spot
' activeMenu defined in CONSTANTS
MenuName = activeMenu
' If the toolbar exists, delete it and create it new.
' Used to prevent duplicates and erors
On Error Resume Next
Application.CommandBars(MenuName).Delete
On Error GoTo 0
' Global name defined in 'Constants' - used for extensability in the
future
' if further menus are needed (ie to turn on/off - delete the 'active'
menu

' set the widths of the menus - keeps them uniform
widths = 100

Call TurnOffUpdates(True)

' Define the arrays that will be used to create the custom toolbar
' to add an element, add an entry in each of the arrays below
' make sure that the inserted elements are all inserted in their
' corresponding slots. ie to add a new menu at position 0
' make sure that it is the first element in Arr0-Arr5
' Arr0 - the Display name of the top level menu
' Arr1 - the tooltip text of the top level menu
' Arr2 - the Display name of the sub-menu items
' Arr3 - the name of the macro that will be called
' Arr4 - the integer value of the FaceId button that will be used
' Arr5 - the tags of the button used to switch pages

Arr0 = Array("O&rder Tools", "&Ledger Tools", "&Customer Tools",
"I&nventory Tools", "&Accountant Tools", "&Summary", "Chan&ge Sheet",
"Hel&p", "Wor&kbook Tools")
Arr1 = Array("Tools for Order Management.", "Tools for Ledger
Management.", "Tools for Customer Management.", "Tools for Inventory
Management.", "Tools for Accountant Documents.", "Summary worksheet.",
"Change the current document being viewed.", "Get Help!", "Tools for
formatting the workbook")

Arr2 = Array(Array("Save Order", "Open Order", "Cancel Order", "",
"Check Order", "", "Reset Order", "", "Print..", "Publish Documents", "",
"View Order"), _
Array("Make Withdrawl", "Make Deposit", "", "Reset Ledger Filters",
"", "Check Overdue Invoices", "", "Print...", "", "View Withdrawls", "View
Deposits"), _
Array("Add Customer", "Edit Customer", "", "Remove Customer", "",
"View Customers", "", "View Customer Orders", "View Sales Journal", "", "Fill
Sales Journal", "Fix Links"), _
Array("Add/Edit Product Line", "Remove Product Line", "", "Refresh
Inventory", "Refresh Inventory Costs", "", "Reset Filter Ranges", "", "View
Inventory", "View Inventory Costs"), _
Array("Print Documents..", "E-Mail Documents"), _
Array("Refresh Top Customers/Products", "", "View Summary"), _
Array("View Order", "View Withdrawls", "View Deposits", "View
Inventory", "View Inventory Costs", "View Customer Orders", "View Sales
Journal", "View Master Price List", "View Wholesale Price List", "View
Customers", "View Summary", "View Data Sheet", "", "View Options"), _
Array("General Help", "Error Code Help"), _
Array(msoControlButton, msoControlButton, msoControlButton,
msoControlComboBox, msoControlButton, msoControlSplitButtonPopup,
msoControlSplitButtonPopup, msoControlSplitButtonPopup))

Arr3 = Array(Array("SaveOrder", "OpenOrder", "CancelOrder", "",
"CheckOrder", "", "ResetOrder", "", "PrintDocuments", "PublishDocuments", "",
"SwitchOut"), _
Array("MakeWithdrawl", "MakeDeposit", "", "resetLedgerFilterRanges",
"", "CheckOverdueInvoice", "", "PrintDocuments", "", "SwitchOut",
"SwitchOut"), _
Array("AddCustomer", "EditCustomer", "", "RemoveCustomer", "",
"SwitchOut", "", "SwitchOut", "SwitchOut", "", "FillSalesJournal",
"FixLinks"), _
Array("AddProductLine", "RemoveProductLine", "",
"RefreshInventory2", "refreshInventoryCosts", "", "resetOrderFilterRanges",
"", "SwitchOut", "SwitchOut"), _
Array("PrintDocuments", "EmailDocuments"), _
Array("refreshSummaryPivotTables", "", "SwitchOut"), _
Array("SwitchOut", "SwitchOut", "SwitchOut", "SwitchOut",
"SwitchOut", "SwitchOut", "SwitchOut", "SwitchOut", "SwitchOut", "SwitchOut",
"SwitchOut", "SwitchOut", "", "SetOptions"), _
Array("HelpGeneral", "HelpErrorCodes"))

Arr4 = Array(Array(271, 270, 1592, 1, 1100, 1, 2010, 1, 4, 610, 1,
2174), _
Array(368, 369, 1, 2010, 1, 1100, 1, 4, 1, 2174, 2174), _
Array(3199, 3203, 1, 1671, 1, 2174, 1, 2174, 2174, 1, 2010, 1100), _
Array(743, 1019, 1, 2010, 2010, 1, 2010, 1, 2174, 2174), _
Array(4, 24), _
Array(2010, 1, 2174), _
Array(2174, 2174, 2174, 2174, 2174, 2174, 2174, 2174, 2174, 2174,
2174, 2174, 1, 2174), _
Array(215, 215), _
Array(3, 109, 4, 1733, 122, 203, 1691, 401))

Arr5 = Array(Array("Work Order", "Work Order", "Work Order", "", "Work
Order", "", "Work Order", "", "Work Order", "Work Order", "", "Work
Order:A1"), _
Array("Withdrawls", "Deposits", "", "Ledger", "", "Ledger", "",
"Ledger", "", "Withdrawls:B3", "Deposits:M3"), _
Array("New", "Edit", "", "Customers", "", "Customers:A1", "",
"Customer Orders:A1", "Sales Journal:A1", "", "Fill SJ", "Fix Links"), _
Array("Inventory", "Inventory", "", "Inventory:Menu", "Inventory",
"", "Inventory", "", "Inventory:A1", "Inventory Costs:A1"), _
Array("Accountant", "Accountant"), _
Array("Summary", "", "Summary:A1"), _
Array("Work Order:A1", "Withdrawls:B3", "Deposits:B3",
"Inventory:A1", "Inventory Costs:A1", "Customer Orders:A1", "Sales
Journal:A1", "Master Price List:A1", "Wholesale Price List:A1",
"Customers:A2", "Summary:A1", "Data:A1", "", ""), _
Array("Help", "Help"))

' create the actual toolbar - MenuName is the text at the top of the
' menu when it is floating
Set CBAR = Application.CommandBars.Add(MenuName, temporary:=False)

' loop through the arrays to create the menus
' outer for loop loops through Arr0 to create the top level names
' inner for loop loops through Arr2 to create the sub-menu names
For i = 0 To UBound(Arr0)
' add the NewMenu to the CommandBar
Set NewMenu = CBAR.Controls.Add(msoControlPopup)
' Create the display name for this top-level item
NewMenu.Caption = Arr0(i)
' create the tooltip text for this top-level item
NewMenu.TooltipText = Arr1(i)
' now add the sub-menu items
For j = 0 To UBound(Arr2(i))
' add the sub-menu item to the NewMenu
If Arr2(i)(j) = "" Then
MenuItm.BeginGroup = True
Else
Set MenuItm = NewMenu.Controls.Add


With MenuItm
If Arr0(i) = "Wor&kbook Tools" Then
'.Type = Arr2(i)(j)
'.ID = Arr4(i)(j)
'.Style = Arr2(i)(j)
.FaceId = Arr4(i)(j)

Else
' add the caption
.Caption = Arr2(i)(j)
' set it to display both icon and text
.Style = msoButtonIconAndCaption
' define the macro associated with it
.OnAction = Arr3(i)(j)
' define the icon to be used
.FaceId = Arr4(i)(j)
' tag to define which element
.tag = Arr5(i)(j)
' define its width to keep it uniform
.Width = widths
End If
End With

End If
Next

Next
' set the bar to be docked with the rest of the toolbars at the top
CBAR.Position = msoBarTop
' make it visibile so it can be used
CBAR.Visible = True
' don't know
DoEvents
Call TurnOffUpdates(False)
End Sub
 
B

Bob Phillips

Isn't your menu called by whatever value activeMenu holds?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
G

Gixxer_J_97

if you mean that if 'activeMenu' contains the string value "Toolbox", then
looking in to toolbars menu you will see 'Toolbox' there, then yes.
 
B

Bob Phillips

So isn't that the commandbar you should use?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
G

Gixxer_J_97

i am, the problem i am having is adding those standard excel buttons to the
menu called "Workbook Tools"
 
G

Gixxer_J_97

if i use this:
Application.CommandBars("Toolbox").Controls.Add
Type:=msoControlSplitButtonPopup, ID:=401, before:=1

it does work, however it adds the button to the top level of the toolbar,
not to the drop-down menu "Workbook Tools"
 
B

Bob Phillips

So how about

Application.CommandBars("Toolbox").Controls("Workbook Tools)>.Controls.Add

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
T

Tom Ogilvy

You need to add you controls to the Workbook Tools control:

Sub rrr()
With Application.CommandBars("Toolbox")
Set cp = .Controls.Add(Type:=msoControlPopup)
End With
cp.Caption = "WorkBook Tools"
With cp
.Controls.Add _
Type:=msoControlSplitButtonPopup, ID:=401, before:=1
End With
End Sub

As an illustration.
 
G

Gixxer_J_97

you know what the most frustrating thing is? i tried that and it gave me an
error. apparently i missed something...

thanks Bob!

J
 
B

Bob Phillips

My error

Application.CommandBars("Toolbox").Controls("Workbook Tools).Controls.Add

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top