Please Help Me with Custom menus

M

Mr BT

Hello
I have an example of a script by someone here in the ng (sorry don't recall
who it was) as the following:

Dim CmdBar As CommandBar
Dim CmdBarMenu As CommandBarControl
Dim CmdBarMenuItem As CommandBarControl
Set CmdBar = Application.CommandBars("My Menu Bar")
Set CmdBarMenu = CmdBar.Controls("Software")
Set CmdBarMenuItem = CmdBarMenu.Controls.Add
With CmdBarMenuItem
.Caption = "Format Column"
.OnAction = "'" & ThisWorkbook.Name & "'!MacroCodeName1"
.Tag = "SomeString"
End With

So this adds "Format Column" to "My Menu Bar" assuming "Software" is a new
menu on the bar. But sometimes its not on the bar, sometimes the bar is
blank. So I have to type "Software", in this case, each time i run the
script...

It actually works great but I want to avoid having to type over and over the
same detail in my menu bar...

Here's a sample that identifies the author as the following...
' macros written 2002-02-28 by Ole P. Erlandsen, (e-mail address removed)


Now before you view the script below, just know it works, but I don't want
the bar floating or disappearing on my from file to file. I want it to be
attached to a file we will call "MyMacros".

I need to be able to set this bar to include a 'newmenu' with menu choices
and more 'newmenus' with other choices...
I really hope that all made sense.

Thank you for all of your help...

Mr BT

Option Explicit

Public Const MyCommandBarName As String = "The CommandBar Name" ' a unique
public CommandBar identification

Sub DeleteMyCommandBar()
' deletes the custom commandbar MyCommandBarName
On Error Resume Next
Application.CommandBars(MyCommandBarName).Delete
On Error GoTo 0
End Sub

Sub CreateMyCommandBar()
' creates the custom commandbar MyCommandBarName
Dim cb As CommandBar, cc As CommandBarButton
DeleteMyCommandBar ' in case it already exists
' create a new temporary commandbar
Set cb = Application.CommandBars.Add(MyCommandBarName, msoBarFloating,
False, True)
With cb
' add a new text button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption1"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonCaption
End With

' add a new text button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption2"
.OnAction = "'" & ThisWorkbook.Name & "'!ToggleButtonState"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonCaption
End With

' add a new text button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption3"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonCaption
End With

' add a new image button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption4"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonIcon
.FaceId = 80 ' the button image
.BeginGroup = True ' add a delimiter in front of the control
End With

' add a new image button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption4"
.OnAction = "'" & ThisWorkbook.Name & "'!ToggleButtonState"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonIcon
.FaceId = 81 ' the button image
End With

' add a new image button
Set cc = cb.Controls.Add(msoControlButton, , , , True)
With cc
.Caption = "Caption4"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.TooltipText = "ButtonDescriptionText"
.Style = msoButtonIcon
.FaceId = 82 ' the button image
End With

Set cc = Nothing
.Visible = True ' display the new commandbar
.Left = 30 ' the left position of the commandbar
.Top = 150 ' the right position of the commandbar
'.Width = 200 ' optional commandbar property
End With

AddMenuToCommandBar cb, True ' add a menu to the commandbar

Set cb = Nothing
End Sub

Private Sub AddMenuToCommandBar(cb As CommandBar, blnBeginGroup As Boolean)
' adds a menu to a commandbar, duplicate this procedure for each menu you
want to create
Dim m As CommandBarPopup, mi As CommandBarButton
If cb Is Nothing Then Exit Sub
' create the menu
Set m = cb.Controls.Add(msoControlPopup, , , , True)
With m
.BeginGroup = blnBeginGroup
.Caption = "MenuCaption"
.TooltipText = "MenuDescriptionText"
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem1"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.FaceId = 80
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem2"
.OnAction = "'" & ThisWorkbook.Name & "'!ToggleButtonState"
.FaceId = 81
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem3"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.FaceId = 82
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

AddSubMenu m, True ' add a sub menu to the menu

Set mi = Nothing
Set m = Nothing
End Sub

Sub AddSubMenu(mm As CommandBarPopup, blnBeginGroup As Boolean)
' adds a menu to an existing menu, duplicate this procedure for each submenu
you want to create
Dim m As CommandBarPopup, mi As CommandBarButton
If mm Is Nothing Then Exit Sub
' create the submenu
Set m = mm.Controls.Add(msoControlPopup, , , , True)
With m
.BeginGroup = blnBeginGroup
.Caption = "MenuCaption"
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem1"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.FaceId = 80
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem2"
.OnAction = "'" & ThisWorkbook.Name & "'!ToggleButtonState"
.FaceId = 81
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem3"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
.FaceId = 82
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

Set mi = Nothing
Set m = Nothing

End Sub

Sub ToggleButtonState()
' toggles a commandbar button state
Dim cc As CommandBarControl
On Error Resume Next
Set cc = Application.CommandBars.ActionControl ' returns the commandbar
button calling the macro
On Error GoTo 0
If Not cc Is Nothing Then ' the macro was started from a commandbar
button
With cc
If .State = msoButtonDown Then
.State = msoButtonUp
MsgBox "This could have disabled something!", vbInformation,
ThisWorkbook.Name ' or call a macro
Else
.State = msoButtonDown
MsgBox "This could have enabled something!", vbInformation,
ThisWorkbook.Name ' or call a macro
End If
End With
Set cc = Nothing
Else ' the macro was not started from a commandbar button
MyMacroName ' call a macro or don't do anything?
End If
End Sub

Sub MyMacroName() ' dummy macro for the example commandbar
MsgBox "This could be your macro running!", vbInformation,
ThisWorkbook.Name
End Sub

' the code below must be placed in the ThisWorkbook module:

'Private Sub Workbook_Open()
' CreateMyCommandBar ' creates the commandbar when the workbook is opened
'End Sub
'
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
' DeleteMyCommandBar ' deletes the commandbar when the workbook is closed
'End Sub
'
'Private Sub Workbook_Activate()
' On Error Resume Next
' ' make the commandbar visible when the workbook is activated
' Application.CommandBars(MyCommandBarName).Visible = True
' On Error GoTo 0
'End Sub
'
'Private Sub Workbook_Deactivate()
' On Error Resume Next
' ' make the commandbar invisible when the workbook is deactivated
' Application.CommandBars(MyCommandBarName).Visible = False
' On Error GoTo 0
'End Sub
 
B

Bob Phillips

Not really sure that I get it, but maybe this will help

Dim CmdBar As CommandBar
Dim CmdBarMenu As CommandBarControl
Dim CmdBarMenuItem As CommandBarControl
On Error Resume Next
Set CmdBar = Application.CommandBars("My Menu Bar")
On Error GoTo 0
If CmdBar Is Nothing Then
Set CmdBar = Application.CommandBars.Add(Name:="My Menu Bar",
temporary:=True)
End If
On Error Resume Next
Set CmdBarMenu = CmdBar.Controls("Software")
On Error GoTo 0
If CmdBarMenu Is Nothing Then
Set CmdBarMenu = CmdBar.Controls.Add(Type:=msoControlPopup,
temporary:=True)
End If
Set CmdBarMenuItem = CmdBarMenu.Controls.Add
With CmdBarMenuItem
.Caption = "Format Column"
.OnAction = "'" & ThisWorkbook.Name & "'!MacroCodeName1"
.Tag = "SomeString"
End With


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
B

Bob Phillips

Small change

Dim CmdBar As CommandBar
Dim CmdBarMenu As CommandBarControl
Dim CmdBarMenuItem As CommandBarControl
On Error Resume Next
Set CmdBar = Application.CommandBars("My Menu Bar")
On Error GoTo 0
If CmdBar Is Nothing Then
Set CmdBar = Application.CommandBars.Add(Name:="My Menu Bar",
temporary:=True)
End If
CmdBar.Visible = True
On Error Resume Next
Set CmdBarMenu = CmdBar.Controls("Software")
On Error GoTo 0
If CmdBarMenu Is Nothing Then
Set CmdBarMenu = CmdBar.Controls.Add(Type:=msoControlPopup,
temporary:=True)
End If
Set CmdBarMenuItem = CmdBarMenu.Controls.Add
With CmdBarMenuItem
.Caption = "Format Column"
.OnAction = "'" & ThisWorkbook.Name & "'!MacroCodeName1"
.Tag = "SomeString"
End With


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
M

Mr BT

Thank you very much for your assistance. I'm sure I can use this
information... But I will ask that you forgive my non-technical thinking
because I know what I want, but haven't seemed to be able to explain it well
in my post. I will try again...

When I open "My Macros" file I need to have a custom bar, we'll call "My
Menu Bar" appear at the top of the screen. I'm not sure if I'm supposed to
work something out in customizing the menu manually...
My Menu Bar will have 2 drop-list menus (please keep in mind I don't want
the menu bar floating)
Menu1 Menu2
Each menu will have a predetermined number of menu choices.
Some with more menu drop-lists, some without
So Menu1 may look something like...
Menu1
->Option1->Option1.1
->Option1.2
->Option1.3
->Option2
->Option3

and so on
each will have an assigned macro to the menu item...

Everytime I open "My Macro" file, this toolbar needs to be there, at the
top. When I use that Excel window to open another excel workbook, beit txt,
xls, or csv I need to see thosemenu options at the top of my screen.

Sorry if my first request for help was confusing. Hope this explains it much
better.


Thank you again.

Mr BT
 
M

Mr BT

Hello again...
I took a closer look at what I had originally, and omitted some scripts to
show the following... This does what I want. I think the amount of text can
be shortened (hoping) but it does what I want... I just need to call the
macros now... I had originally thought that all of what I'm giving below
could be done under one macro script instead of being separated into 3
different commands and linking them together.
The following is Ole P. Erlandsen's work, with the unusable text removed:
' macros written 2002-02-28 by Ole P. Erlandsen, (e-mail address removed)

Option Explicit

Public Const MyCommandBarName As String = "The CommandBar Name" ' a unique
public CommandBar identification

Sub DeleteMyCommandBar()
' deletes the custom commandbar MyCommandBarName
On Error Resume Next
Application.CommandBars(MyCommandBarName).Delete
On Error GoTo 0
End Sub

Sub CreateMyCommandBar()
' creates the custom commandbar MyCommandBarName
Dim cb As CommandBar, cc As CommandBarButton
DeleteMyCommandBar ' in case it already exists
' create a new temporary commandbar
Set cb = Application.CommandBars.Add(MyCommandBarName, msoBarFloating,
False, True)
With cb
Set cc = Nothing
.Visible = True ' display the new commandbar
.Left = 30 ' the left position of the commandbar
.Top = 150 ' the right position of the commandbar
'.Width = 200 ' optional commandbar property
End With

AddMenuToCommandBar cb, True ' add a menu to the commandbar

Set cb = Nothing
End Sub

Private Sub AddMenuToCommandBar(cb As CommandBar, blnBeginGroup As Boolean)
' adds a menu to a commandbar, duplicate this procedure for each menu you
want to create
Dim m As CommandBarPopup, mi As CommandBarButton
If cb Is Nothing Then Exit Sub
' create the menu
Set m = cb.Controls.Add(msoControlPopup, , , , True)
With m
.BeginGroup = blnBeginGroup
.Caption = "MenuCaption"
.TooltipText = "MenuDescriptionText"
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem1"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
' .FaceId = 80
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With


AddSubMenu m, True ' add a sub menu to the menu

Set mi = Nothing
Set m = Nothing
End Sub

Sub AddSubMenu(mm As CommandBarPopup, blnBeginGroup As Boolean)
' adds a menu to an existing menu, duplicate this procedure for each submenu
you want to create
Dim m As CommandBarPopup, mi As CommandBarButton
If mm Is Nothing Then Exit Sub
' create the submenu
Set m = mm.Controls.Add(msoControlPopup, , , , True)
With m
.BeginGroup = blnBeginGroup
.Caption = "MenuCaption"
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem1"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
' .FaceId = 80
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem2"
.OnAction = "'" & ThisWorkbook.Name & "'!ToggleButtonState"
' .FaceId = 81
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

' add a menu item
Set mi = m.Controls.Add(msoControlButton, , , , True)
With mi
.Caption = "MenuItem3"
.OnAction = "'" & ThisWorkbook.Name & "'!MyMacroName"
' .FaceId = 82
.Style = msoButtonIconAndCaption
' .Style = msoButtonCaption ' caption only, no icon, .FaceId not
necessary
End With

Set mi = Nothing
Set m = Nothing

End Sub

Sub ToggleButtonState()
' toggles a commandbar button state
Dim cc As CommandBarControl
On Error Resume Next
Set cc = Application.CommandBars.ActionControl ' returns the commandbar
button calling the macro
On Error GoTo 0
If Not cc Is Nothing Then ' the macro was started from a commandbar
button
With cc
If .State = msoButtonDown Then
.State = msoButtonUp
MsgBox "This could have disabled something!", vbInformation,
ThisWorkbook.Name ' or call a macro
Else
.State = msoButtonDown
MsgBox "This could have enabled something!", vbInformation,
ThisWorkbook.Name ' or call a macro
End If
End With
Set cc = Nothing
Else ' the macro was not started from a commandbar button
MyMacroName ' call a macro or don't do anything?
End If
End Sub
 
M

Mr BT

What I posted previous works great except two points:
1. Whenever I run the script it makes the toolbar float. I want it where the
rest of the toolbars appear.
2. I won't attach itself to my file which I really want.
Can anyone assist me?
Thank you
Mr BT
 
M

Mr BT

I've been referring to the menu bar incorrectly i think... I don't know the
difference really, but I think its a Toolbar I want and not a commandbar.
Does that change things for what kind of help I should expect?


Mr BT
 
M

Mr BT

I found an answer to my question below, and I'm now using the following:

Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl

'(1)Delete any existing one. We must use On Error Resume next _
in case it does not exist.
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
On Error GoTo 0

'(2)Set a CommandBar variable to Worksheet menu bar
Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")

'(3)Return the Index number of the Help menu. We can then use _
this to place a custom menu before.
iHelpMenu = _
cbMainMenuBar.Controls("Help").Index

'(4)Add a Control to the "Worksheet Menu Bar" before Help.
'Set a CommandBarControl variable to it
Set cbcCutomMenu = _
cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)

'(5)Give the control a caption
cbcCutomMenu.Caption = "&New Menu"

'(6)Working with our new Control, add a sub control and _
give it a Caption and tell it which macro to run (OnAction).
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Menu 1"
.OnAction = "MyMacro1"
End With
'(6a)Add another sub control give it a Caption _
and tell it which macro to run (OnAction)
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Menu 2"
.OnAction = "MyMacro2"
End With
'Repeat step "6a" for each menu item you want to add.


'Add another menu that will lead off to another menu
'Set a CommandBarControl variable to it
Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
' Give the control a caption
cbcCutomMenu.Caption = "Ne&xt Menu"

'Add a contol to the sub menu, just created above
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "&Charts"
.FaceId = 420
.OnAction = "MyMacro2"
End With



End Sub

Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&New
Menu").Delete
On Error GoTo 0
End Sub



It actually works out better because the associates that will be using the
workbook don't like the extra menus cluttering the top (or bottom) of their
window.
I'll still be including "maintenance" type toolbars with customized groups
of buttons. However the above script works great.

thanks to
http://www.ozgrid.com/VBA/custom-menus.htm
 

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