Here is an interesting one. I create a menu bar with the code below. It works fine. When I run one of the menu selections that opens a modeless dialog from this menu bar after the box is dismissed the menu bar resets its position up at the top vs. where I last left it. Any thoughts?
Sub CreateCustomCommandBar()
' creates a new custom commandbar
Dim cb As CommandBar, cbMenu As CommandBarPopup, cbButton As CommandBarButton
DeleteCustomCommandBar ' delete the commandbar if it already exists
' create the new commandbar
Set cb = Application.CommandBars.Add(ThisCommandBarName, msoBarTop, False, True)
' add a menu to the new commandbar
Set cbMenu = cb.Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&BOM Query Tools"
'.Tag = "MyTag"
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Get 4D Pricing"
.OnAction = ThisWorkbook.Name & "!GetCosts"
shtCustomIcons.Shapes("4D").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Override Item Master Pricing"
.OnAction = ThisWorkbook.Name & "!OverRide"
.FaceId = 319
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Reset to Item Master Pricing"
.FaceId = 320
.OnAction = ThisWorkbook.Name & "!Reset"
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Price Differences - 2 BOM's"
.OnAction = ThisWorkbook.Name & "!PrepForList"
.FaceId = 531
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Find Parts With No Price"
shtCustomIcons.Shapes("parts").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.OnAction = ThisWorkbook.Name & "!ListOfNonPricedParts"
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Find Assemblies With No Price"
shtCustomIcons.Shapes("assys").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.OnAction = ThisWorkbook.Name & "!ListOfNonPricedAssys"
End With
'---------------------------------------------------------------------------------
' add a button to the commandbar, use a built-in FaceId
Set cbButton = cb.Controls.Add(msoControlButton, , , , True)
With cbButton
.Caption = "&Display Color Legend"
shtCustomIcons.Shapes("colorlegend").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!ShowLegend"
.TooltipText = "Display Color Legend for Cells"
End With
Set cbButton = cb.Controls.Add(msoControlButton, , , , True)
With cbButton
.Caption = "Display Hierarchial List"
.FaceId = 632 ' trash bin
'shtCustomIcons.Shapes("listview").Copy ' copy the custom icon
'.PasteFace ' paste the custom icon
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!ViewTree"
.TooltipText = "View A Hierarchial List"
End With
cb.Visible = True ' display the custom commandbar
Set cbButton = Nothing
Set cbMenu = Nothing
Set cb = Nothing
End Sub
Sub DeleteCustomCommandBar()
' delete the commandbar if it already exists
On Error Resume Next
Application.CommandBars(ThisCommandBarName).Delete
On Error GoTo 0
End Sub
Function CopyPictureFromFile(TargetWS As Worksheet, SourceFile As String) As Boolean
' inserts a picture from SourceFile into TargetWS
' copies the picture to the clipboard
' deletes the inserted picture
' returns TRUE if a picture is copied to the clipboard
' the picture can be pasted from the clipboard e.g. to a custom commbarbutton
Dim p As Object
CopyPictureFromFile = False
If TargetWS Is Nothing Then Exit Function
If Len(Dir(SourceFile)) = 0 Then Exit Function
On Error GoTo NoPicture
Set p = TargetWS.Pictures.Insert(SourceFile)
p.CopyPicture xlScreen, xlPicture
p.Delete
Set p = Nothing
On Error GoTo 0
CopyPictureFromFile = True
Exit Function
NoPicture:
End Function
Sub CreateCustomCommandBar()
' creates a new custom commandbar
Dim cb As CommandBar, cbMenu As CommandBarPopup, cbButton As CommandBarButton
DeleteCustomCommandBar ' delete the commandbar if it already exists
' create the new commandbar
Set cb = Application.CommandBars.Add(ThisCommandBarName, msoBarTop, False, True)
' add a menu to the new commandbar
Set cbMenu = cb.Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = "&BOM Query Tools"
'.Tag = "MyTag"
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "&Get 4D Pricing"
.OnAction = ThisWorkbook.Name & "!GetCosts"
shtCustomIcons.Shapes("4D").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Override Item Master Pricing"
.OnAction = ThisWorkbook.Name & "!OverRide"
.FaceId = 319
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Reset to Item Master Pricing"
.FaceId = 320
.OnAction = ThisWorkbook.Name & "!Reset"
End With
' add a menu item to the menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Price Differences - 2 BOM's"
.OnAction = ThisWorkbook.Name & "!PrepForList"
.FaceId = 531
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Find Parts With No Price"
shtCustomIcons.Shapes("parts").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.OnAction = ThisWorkbook.Name & "!ListOfNonPricedParts"
.BeginGroup = True
End With
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = "Find Assemblies With No Price"
shtCustomIcons.Shapes("assys").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.OnAction = ThisWorkbook.Name & "!ListOfNonPricedAssys"
End With
'---------------------------------------------------------------------------------
' add a button to the commandbar, use a built-in FaceId
Set cbButton = cb.Controls.Add(msoControlButton, , , , True)
With cbButton
.Caption = "&Display Color Legend"
shtCustomIcons.Shapes("colorlegend").Copy ' copy the custom icon
.PasteFace ' paste the custom icon
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!ShowLegend"
.TooltipText = "Display Color Legend for Cells"
End With
Set cbButton = cb.Controls.Add(msoControlButton, , , , True)
With cbButton
.Caption = "Display Hierarchial List"
.FaceId = 632 ' trash bin
'shtCustomIcons.Shapes("listview").Copy ' copy the custom icon
'.PasteFace ' paste the custom icon
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!ViewTree"
.TooltipText = "View A Hierarchial List"
End With
cb.Visible = True ' display the custom commandbar
Set cbButton = Nothing
Set cbMenu = Nothing
Set cb = Nothing
End Sub
Sub DeleteCustomCommandBar()
' delete the commandbar if it already exists
On Error Resume Next
Application.CommandBars(ThisCommandBarName).Delete
On Error GoTo 0
End Sub
Function CopyPictureFromFile(TargetWS As Worksheet, SourceFile As String) As Boolean
' inserts a picture from SourceFile into TargetWS
' copies the picture to the clipboard
' deletes the inserted picture
' returns TRUE if a picture is copied to the clipboard
' the picture can be pasted from the clipboard e.g. to a custom commbarbutton
Dim p As Object
CopyPictureFromFile = False
If TargetWS Is Nothing Then Exit Function
If Len(Dir(SourceFile)) = 0 Then Exit Function
On Error GoTo NoPicture
Set p = TargetWS.Pictures.Insert(SourceFile)
p.CopyPicture xlScreen, xlPicture
p.Delete
Set p = Nothing
On Error GoTo 0
CopyPictureFromFile = True
Exit Function
NoPicture:
End Function