Set a CommandBar "Popup" submenu icon dynamically - vba

I'm just trying to confirm this: In Office 2003, I want to create a custom submenu--what is known in CommandBar parlance as a popup (msoControlPopup)--at runtime, and set an image for it. With a CommandBarButton, this is very straightforward
Set btn1 = mnu.Controls.Add(msoControlButton, temporary:=True)
btn1.Caption = "Btn1"
btn1.Picture = stdole.LoadPicture("C:\temp\test.bmp")
But with a CommandBarPopup, or CommandBarControl of type msoControlPopup, it fails
Set sub1 = mnu.Controls.Add(msoControlPopup, temporary:=True)
sub1.Caption = "Sub1"
'object doesn't support this property or method for next line
sub1.Picture = stdole.LoadPicture("C:\temp\test.bmp")
The msoControlPopup type doesn't seem to allow a .Style property either, which is how Office determines what to show--icon, text, both--on the control. I haven't found this proven yet, so am holding out a last hope that I'm doing something wrong, and there is, in fact, a way to insert an icon on a submenu at runtime.
Thanks for any light you can shed.

Ok well more tumbleweeds. I'm pretty sure the answer to this is, it can't be done. And here's my "proof": None of the built-in submenus have icons (which I didn't realize until after I posted the above, and if you run the above code, go to Tools > Customize in the menu bar, then click on the Test menu to drop it down, and right-click on Sub1, you should see all the button and style options greyed out. Right-click on Btn1, and they're available.
Any other thoughts still welcome.

Of course if you need to set the image or FaceID of the submenu heading, that is not an available method for submenu headings, but if you want to set the image or FaceID on the submenu itself, I modified code from here to accomplish this:
Public Sub newSubMenu()
Dim menuBar As CommandBar
Dim newMenu As CommandBarControl
Dim menuItem As CommandBarControl
Dim subMenuItem As CommandBarControl
CommandBars("Sub Menu Bar").Delete
Set menuBar = CommandBars.Add(menuBar:=False, Position:=msoBarPopup, Name:="Sub Menu Bar", Temporary:=True)
Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
newMenu.Caption = "&First Menu"
Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
newMenu.Caption = "&Second Menu"
Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup)
newMenu.Caption = "&Third Menu"
Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
With menuItem
.Caption = "F&irst Sub"
.FaceId = "356"
.OnAction = "myTest"
End With
Set menuItem = newMenu.Controls.Add(Type:=msoControlButton)
With menuItem
.Caption = "S&econd Sub"
.FaceId = "333"
.OnAction = "otherTest"
End With
Set menuItem = newMenu.Controls.Add(Type:=msoControlPopup)
menuItem.Caption = "Sub Menus"
Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
With subMenuItem
.Caption = "Item 1"
.FaceId = 321
.OnAction = "firstMacro"
End With
Set subMenuItem = menuItem.Controls.Add(Type:=msoControlButton)
With subMenuItem
.Caption = "Item 2"
'.FaceId = 432
.Picture = stdole.StdFunctions.LoadPicture("C:\temp\test.bmp")
.OnAction = "secondMacro"
End With
CommandBars("Sub Menu Bar").ShowPopup
End Sub
I tested this and it appears to work fine for both FaceID's and loaded pictures.
Of course to get the "on run time" affect, I would recommend placing this in a function which was called each time the user clicked on a specific control.
It could be further expended to handle variable pictures here as well.
Hope this helps.

Related

Use the Default Background Color Picker Popup menu

Summary:
I'm trying to make a custom popup menu with some options, amongst which i would like to insert the default background color picker from the Text Formatting tab. With this, i would love if i could know which color code has been picked so i can set it as a background color for a textbox.
What i have tried:
Sub Make_Popup_CuloriForm()
'Add PopUp menu
With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
MenuBar:=False, Temporary:=True)
With .Controls.Add(Type:=msoControlButton)
.Caption = "Actualizeaza formular"
.OnAction = "fCuloriForm"
.Parameter = "1"
.FaceId = 159
.BeginGroup = True
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Elimina formular"
.OnAction = "fCuloriForm"
.Parameter = "2"
.FaceId = 330
.BeginGroup = True
End With
End With
' Application.CommandBars.Add c(36)
End Sub
What i need is to add another control to the popup menu, but that should be the builtin color picker.
thank you
LE:
This is what i need:

VBA to add a macro to the right mouse click in word

I'm running Word in Office 365; I have a Macro which I can run from a button added to the ribbon, but that requires access to the machine it's running on (at least, the way I did it) and this file is to go out to a distributed workforce.
I'm trying to write a macro in the document which will add a button to the drop-down menu that comes up when you right click on a text selection, but the code below doesn't add anything to the menu.
Sub AddToShortcut()
Dim Bar As CommandBar
Dim NewControl As CommandBarButton
DeleteFromShortcut
Set Bar = Application.CommandBars("Standard")
Set NewControl = Bar.Controls.Add(Type:=msoControlButton, ID:=1, Temporary:=True)
With NewControl
.Caption = "&New Action"
.OnAction = "AddAction"
.Style = msoButtonIconAndCaption
End With
End Sub
Private Sub document_open()
'adds the right-click shortcut when the document opens
Call AddToShortcut
End Sub
I got the core of the code from John Walkenbach's Excel VBA Programming for Dummies, so I'm presuming there's some difference between the way Word and Excel operate that's causing the issue?
You want to add it to the "Text" contextual menu, not "Standard."
The following is straight from Greg Maxey's page that you said was too much. It is the answer, though. Your code would be around oBtn.
You would put this in a Global Template stored in your Word Startup Folder (links to my pages). It could be renamed AutoExec or called from an AutoExec procedure in that template.
Option Explicit
Dim oPopUp As CommandBarPopup
Dim oCtr As CommandBarControl
Sub BuildControls()
Dim oBtn As CommandBarButton
'Make changes to the Add-In template
CustomizationContext = ThisDocument.AttachedTemplate
'Prevent double customization
Set oPopup = CommandBars.FindControl(Tag:="custPopup")
If Not oPopup Is Nothing Then GoTo Add_Individual
'Add PopUp menu control to the top of the "Text" short-cut menu
Set oPopUp = CommandBars("Text").Controls.Add(msoControlPopup, , , 1)
With oPopUp
.Caption = "My Very Own Menu"
.Tag = "custPopup"
.BeginGroup = True
End With
'Add controls to the PopUp menu
Set oBtn = oPopUp.Controls.Add(msoControlButton)
With oBtn
.Caption = "My Number 1 Macro"
.FaceId = 71
.Style = msoButtonIconAndCaption
'Identify the module and procedure to run
.OnAction = "MySCMacros.RunMyFavMacro"
End With
Set oBtn = Nothing
'Add a Builtin command using ID 1589 (Co&mments)
Set oBtn = oPopUp.Controls.Add(msoControlButton, 1589)
Set oBtn = Nothing
'Add the third button
Set oBtn = oPopUp.Controls.Add(msoControlButton)
With oBtn
.Caption = "AutoText Complete"
.FaceId = 940
.Style = msoButtonIconAndCaption
.OnAction = "MySCMacros.MyInsertAutoText"
End With
Set oBtn = Nothing
Add_Individual:
'Or add individual commands directly to menu
Set oBtn = CommandBars.FindControl(Tag:="custCmdBtn")
If Not oBtn Is Nothing Then Exit Sub
'Add control using built-in ID 758 (Boo&kmarks...)
Set oBtn = Application.CommandBars("Text").Controls.Add(msoControlButton, 758, , 2)
oBtn.Tag = "custCmdBtn"
If MsgBox("This action caused a change to your Add-In template." _
& vbCr + vbCr & "Recommend you save those changes now.", vbInformation + vbOKCancel, _
"Save Changes") = vbOK Then
ThisDocument.Save
End If
Set oPopUp = Nothing
Set oBtn = Nothing
lbl_Exit:
Exit Sub
End Sub

Create a right-click context menu in Outlook 2003

I'm already able to create a new menu in the top menubar of Outlook 2003 but would like to do the same when the user right-click on an email (but not anywhere else in the interface if possible).
Here is what I got:
Sub AddMenus()
Dim cbMainMenuBar As CommandBar
Dim cbcCustomMenu As CommandBarControl
Dim cbcTest As CommandBarControl
Dim iHelpMenu as Integer
Set cbMainMenuBar = Application.ActiveExplorer.CommandBars.ActiveMenuBar
iHelpMenu = cbMainMenuBar.Controls("&?").index
Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, before:=iHelpMenu)
cbcCustomMenu.caption = "Menu &Name"
Set cbcTest = cbcCustomMenu.Controls.Add(Type:=msoControlPopup)
cbcTest.caption = "&Test"
With cbcTest.Controls.Add(Type:=msoControlButton)
.caption = "&Submenu item"
.OnAction = "macro"
End With
With cbcTest.Controls.Add(Type:=msoControlButton)
.caption = "Another submenu item"
.OnAction = "macro"
End With
With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
.caption = "About"
.OnAction = "macro"
End With
End Sub
What do I have to change to make this works when right-clicking?
The definitive answer to the problem can be found here: http://www.outlookcode.com/codedetail.aspx?id=314
Here is what I come with after removing some of the code/comments I didn't need:
Option Explicit
Private WithEvents ActiveExplorerCBars As CommandBars
Private WithEvents ContextButton As CommandBarButton
Private IgnoreCommandbarsChanges As Boolean
Private Sub Application_Startup()
Set ActiveExplorerCBars = ActiveExplorer.CommandBars
End Sub
Private Sub ActiveExplorerCBars_OnUpdate()
Dim bar As CommandBar
If IgnoreCommandbarsChanges Then Exit Sub
On Error Resume Next
Set bar = ActiveExplorerCBars.Item("Context Menu")
On Error GoTo 0
If Not bar Is Nothing Then
AddContextButton bar
End If
End Sub
Sub AddContextButton(ContextMenu As CommandBar)
Dim b As CommandBarButton
Dim subMenu As CommandBarControl
Dim cbcCustomMenu As CommandBarControl, cbcLink As CommandBarControl
Set ContextMenu = ActiveExplorerCBars.Item("Context Menu")
'Unprotect context menu
ChangingBar ContextMenu, Restore:=False
'Menu
Set cbcCustomMenu = ContextMenu.Controls.Add(Type:=msoControlPopup)
cbcCustomMenu.caption = "&Menu"
'Link in Menu
Set cbcLink = cbcCustomMenu.Controls.Add(Type:=msoControlButton)
cbcLink.caption = "Link 1"
cbcLink.OnAction = "macro"
'Reprotect context menu
ChangingBar ContextMenu, Restore:=True
End Sub
'Called once to prepare for changes to the command bar, then again with
'Restore = true once changes are complete.
Private Sub ChangingBar(bar As CommandBar, Restore As Boolean)
Static oldProtectFromCustomize, oldIgnore As Boolean
If Restore Then
'Restore the Ignore Changes flag
IgnoreCommandbarsChanges = oldIgnore
'Restore the protect-against-customization bit
If oldProtectFromCustomize Then bar.Protection = bar.Protection And msoBarNoCustomize
Else
'Store the old Ignore Changes flag
oldIgnore = IgnoreCommandbarsChanges
IgnoreCommandbarsChanges = True
'Store old protect-against-customization bit setting then clear
'CAUTION: Be careful not to alter the property if there is no need,
'as changing the Protection will cause any visible CommandBarPopup
'to disappear unless it is the popup we are altering.
oldProtectFromCustomize = bar.Protection And msoBarNoCustomize
If oldProtectFromCustomize Then bar.Protection = bar.Protection And Not msoBarNoCustomize
End If
End Sub
I no longer have Outlook 2003 installed and Outlook 2010 doesn't let you mess with right-click menus the same way. So this compiles and is, hopefully close to what you need to do.
Before writing any code, you'll want to show hidden items, I think, to get the Intellisense for a couple of objects. In 2010 the ActiveExporer and ActiveInspector objects - which are the two types of view in Outlook, e.g., looking at all you email, or looking at a single email - are hidden. To unhide them, go into the Object Explorer by clicking F2 in the VBE, and right-click just about anywhere and check "Show Hidden Items".
So now you're ready to code:
First you need a way to determine the name of the right-click menu you are interested in. This tries to add a button to every menu, with the button's caption being the name and index of the menu. It resets the menu first, so as to not create more than one such button. The button should be at the bottom of the menu. The buttons are temporary, meaning they'll be gone the next time you open Outlook:
Sub GetCommandBarNames()
Dim cbar As Office.CommandBar
Dim cbarButton As Office.CommandBarButton
For Each cbar In ActiveInspector.CommandBars
On Error Resume Next
cbar.Reset
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
With cbarButton
.Caption = cbar.Name
.Style = msoButtonCaption
.Visible = True
End With
On Error GoTo 0
Next cbar
For Each cbar In ActiveExplorer.CommandBars
On Error Resume Next
cbar.Reset
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
With cbarButton
.Caption = cbar.Name & "-" & cbar.Index
.Style = msoButtonCaption
.Visible = True
End With
On Error GoTo 0
Next cbar
End Sub
After running this, right-click in Outlook and get the name of the menu you want. It will be the part before the dash on the last button. Let's say it's "foobar".
You should then be able to do this:
Sub AddButton()
Dim cbar As Office.CommandBar
Dim cbarButton As Office.CommandBarButton
Set cbar = ActiveExplorer.CommandBars("foobar") 'or maybe it's ActiveInspector
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
With cbarButton
.Caption = "&Submenu item"
.OnAction = "macro"
.Style = msoButtonCaption
'etc.
End With
'do the next button
Set cbarButton = cbar.Controls.Add(Type:=msoControlButton, temporary:=True)
'...
End Sub
Like I say, I'm doing this a bit blind, but I've done it many times in Excel (I even wrote two addins), so if this doesn't work, I should be able to get you there.

How to add icons to custom menu in excel - vba

I have created some custom menu referring "Custom Menu visible to one document in Excel". Now I want to add some icons to each menu item. Either that may be system icons or some others. Please provide some solution.
use the .FaceID property. If you want to know what id to use, then download a FaceID Browser addin for excel. Example:
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Save XML Data"
.FaceId = 270
.OnAction = "AskExportXml"
.Enabled = True
End With

Programmatically add a hyperlink button to outlook 2007

I am adding a toolbar to Outlook.
The toolbar will have one button on it.
This button, when pressed, will open up a web site.
I've created the button & toolbar no problem, but cannot work out how to add the hyperlink?
Set oTBar = oView.Add("toolbarname")
oTBar.Position = 1
oTBar.Visible = true
Set oButton = OTBar.Controls.Add
With oButton
.Caption = "Click here!"
.Style = 3
.HyperlinkType = 1
.FaceId = 1707
End with
Haha!
You need to add it as the tooltip:
.ToolTipText = "http://your_url"