View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Mr BT Mr BT is offline
external usenet poster
 
Posts: 12
Default Please Help Me with Custom menus

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,


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