LinkBack URL
About LinkBacksHello
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, [email protected]
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
Register To Reply
Bookmarks