Public Sub AddMenuItem(cmbTargetMenuBar As CommandBar, _
strMenuTitle As String, strItemCaption As String, strItemOnAction As String, _
Optional booFlyOut As Boolean, Optional strFlyOutTitle As String, _
Optional imgItemIcon As Image)
'created by Loose Cannon (VBAX handle), July 2006
Dim booMenuExists As Boolean, booFlyOutExists As Boolean, booItemExists As Boolean
Dim cbpDestinationMenu As CommandBarPopup, cbpDestinationFlyOut As CommandBarPopup
Dim cbbNewMenuItem As CommandBarButton
'' Does a menu item with .Caption = strMenuTitle exist in cmbTargetMenuBar? (probably done using a for each obj in cmb)
booMenuExists = FN_booMenuExists(cmbTargetMenuBar, strMenuTitle)
If booMenuExists Then
'' If True, set as DestinationMenu
Set cbpDestinationMenu = cmbTargetMenuBar.Controls(strMenuTitle)
'' If False, create one and set as DestinationMenu
Else
Set cbpDestinationMenu = cmbTargetMenuBar.Controls.Add(msoControlPopup, , , , False)
cbpDestinationMenu.Caption = strMenuTitle
End If
If booFlyOut Then
'' Does a flyout branch with .Caption = strFlyOutTitle exist in DestinationMenu?
booFlyOutExists = FN_booFlyOutExists(cbpDestinationMenu, strFlyOutTitle)
If booFlyOutExists Then
'' If True, set as DestinationFlyOut
Set cbpDestinationFlyOut = FN_cbpSetFlyOut(cbpDestinationMenu, strFlyOutTitle) ''causing problems with recoginition of "&" in strFlyOutTitle
' If cbpDestinationFlyOut = Nothing Then Exit Sub 'not sure this is necessary - PB
Else
'' If False, create one and set as DestinationFlyOut
Set cbpDestinationFlyOut = cbpDestinationMenu.Controls.Add(msoControlPopup, , , , False)
cbpDestinationFlyOut.Caption = strFlyOutTitle
End If
'' Does a menu item with .Caption = strItemCaption exist in DestinationFlyOut
booItemExists = FN_booItemExists(cbpDestinationFlyOut, strItemCaption)
If Not booItemExists Then
'' If False create and set .OnAction = strItemOnAction
Set cbbNewMenuItem = cbpDestinationFlyOut.Controls.Add(msoControlButton, , , , False)
With cbbNewMenuItem
.Caption = strItemCaption
.OnAction = strItemOnAction
.Picture = imgItemIcon.Picture
End With
Else
'' If True, exit
Exit Sub
End If
Else ''not a fly out item
'' Does a menu item with .Caption = strItemCaption exist in DestinationMenu
booItemExists = FN_booItemExists(cbpDestinationMenu, strItemCaption)
If Not booItemExists Then
'' If False create and set .OnAction = strItemOnAction
Set cbbNewMenuItem = cbpDestinationMenu.Controls.Add(msoControlButton, , , , False)
With cbbNewMenuItem
.Caption = strItemCaption
.OnAction = strItemOnAction
.Picture = imgItemIcon.Picture
End With
Else
'' If True, exit
Exit Sub
End If
End If
End Sub
The item being added, cbbNewMenuItem is defined as a CommandBarButton. PasteFace appears in the properties/methods hot list for it and allows the project to compile, but is not then recognised when the code is run.
Passing in an image from a user form as imgItemIcon works with cbbNeMenuItem.Picture = imgItemIcon.Picture. However, I wondered if there was a way of reading images directly from the worksheet.
Your help is much appreciated!