I have built a custom menu to insert images into MS Word. Each sub-menu item is linked to a macro that inserts the image. When I run the macro individually, it inserts the correct image. However, when I click the respective item from the addin menu, it always inserts the first image. so, that tells me that there is an issue with the code in my addin menu.
The code below creates the addin menu:
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=10, _
Temporary:=True)
MenuObject.Caption = "Images"
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = "set 1"
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = "image name 1"
SubMenuItem.OnAction = "macro_1"
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = "image name 2"
SubMenuItem.OnAction = "macro_2"
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = "image name 3"
SubMenuItem.OnAction = "macro_3"
The macro code that insert the images:
Sub macro_1()
Dim objTbl As Table
Dim rg As Range
With ActiveDocument
Set objTbl = .Tables(1)
Set rg = objTbl.Cell(Row:=nRow, Column:=1).Range
.InlineShapes.AddPicture _
FileName:="\\shared drive path\image_1.PNG", Range:=rg
End With
End Sub
I have separate sub's to insert the other images and is identical to the above, except for the PNG's are different. (image_2.PNG, image_3.PNG)
When running the macro's individually they work fine. When I click the menu items linked to the macro's, it always inserts "Image_1" PNG. Cannot seems to figure out why!
Related
I tried this
Set cbCat = CommandBars.Add(conBarName, msoBarPopup, False, False)
Set cbCatCtrl = cbCat.Controls.Add(msocontrolpopup)
cbCatCtrl.Caption = "Open Form"
Do While Not rsForms.EOF
Set cbObjectCtrl = cbCatCtrl.Controls.Add()
With cbObjectCtrl
.Caption = rsForms!Name
.Tag = rsForms!Name
.OnAction = "OpenForm"
' .Picture = stdole.StdFunctions.LoadPicture("D:\1.bmp")
But it doesn’t work , Error Invalid Picture , I tried .ICO Icons but still the same .
How can I load a picture from my pc and use it as icon instead of faceID method ?
Thanks in Advance
Hy,
I got this from :
Docs.Microsoft
It looks like you need to create a IPictureDisp first and then link this to the relevant control. Also try using a .bmp
Sub ChangeButtonImage()
Dim picPicture As IPictureDisp
Set picPicture = stdole.StdFunctions.LoadPicture( _
"c:\images\picture.bmp")
'Here you need to reference your control.
With Application.CommandBars.FindControl(msoControlButton)
'Change the button image.
.Picture = picPicture
End With
End Sub
Looking forward to your solution...
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
I would like to hide a few of the items that are shown in the popup menu when right-clicking on a drawing shape in Visio.
The code I tried. There is no change seen.
Sub HideVisioMenus()
Dim uiObj As Visio.UIObject
Dim menuSetObj As Visio.MenuSet
Dim menuItemsObj As Visio.menuitems
Dim i As Integer
Set uiObj = Visio.Application.BuiltInMenus
Set menuSetObj = uiObj.MenuSets.ItemAtID(visUIObjSetDrawing)
Set menuItemsObj = menuSetObj.Menus(8).menuitems
'Get the Show ShapeSheet menu item by its CmdNum property.
For i = 0 To menuItemsObj.Count - 1
Debug.Print menuItemsObj.Item(i).Caption
If menuItemsObj(i).CmdNum = visCmdWindowShowShapeSheet Then
menuItemsObj.Item(i).Visible = False
Exit For
End If
Next i
Visio.Application.SetCustomMenus uiObj
End Sub
Maybe what you are looking for is actually disabling Developer Mode? (it's in the settings). Unchecking that will hide the "ShapeSheet" command from the context menu. Please note that developer mode is already disabled by default. You can also turn it off programmatically like this:
Application.Settings.DeveloperMode = False
FYI: There are other methods as well, like disabling by registry settings (administration policies). I have a small note on this here: https://unmanagedvisio.com/disabling-visio-built-in-commands/
Which version of Visio are you using? I've been fiddling with the RibbonUI for so long, I forgot about hiding/removing items using CommandBars.
I honestly couldn't remember if it even works with the ribbon. So I fiddled around and it does work!
I think that you need this menuset id, though:
Visio.visUIObjSetCntx_DrawObjSel
However, walking through the items in that set doesn't reveal the Show ShapeSheet item. So that item is added in some special way by Visio.
I fiddled with some code and was able to hide everything but Show ShapeSheet and Hyperlinks. No idea how to get rid of those!
Sub DinkWithRightClickShapeMenu()
'// The following example demonstrates how to retrieve
'// the currently active user interface for your document
'// without replacing the application-level custom user
'// interface, if any.
'// Check if there are document custom menus.
If ThisDocument.CustomMenus Is Nothing Then
'Check if there are Visio custom menus.
If Visio.Application.CustomMenus Is Nothing Then
'Use the built-in menus.
Set visUiObj = Visio.Application.BuiltInMenus
Else
'Use the Visio custom menus.
Set visUiObj = Visio.Application.CustomMenus.Clone
End If
Else
'Use the file custom menus
Set visUiObj = ThisDocument.CustomMenus
End If
Dim menuSetObj As Visio.MenuSet
Dim menuItemsObj As Visio.MenuItems
Dim i As Integer, j As Integer
'// This is the menu set for right-clicking a shape:
Set menuSetObj = visUiObj.MenuSets.ItemAtID(Visio.visUIObjSetCntx_DrawObjSel)
'Set menuSetObj = visUIObj.MenuSets.ItemAtID(Visio.visUIObjSetCntx_BuiltinMenus)
'// List the menu items in the menu set.
'// For Each doesn't work:
Dim mnu As Visio.Menu
Dim mnuItem As Visio.MenuItem
For i = 0 To menuSetObj.Menus.Count - 1
Set mnu = menuSetObj.Menus.Item(i)
Debug.Print "Menu: " & i & ". '" & mnu.Caption & "'"
For j = 0 To mnu.MenuItems.Count - 1
Set mnuItem = mnu.MenuItems(j)
Debug.Print j, mnuItem.Caption
'// Hide every menu item:
mnuItem.Visible = False
'// This was a test to see if I could change the menu text:
'//mnuItem.Caption = mnuItem.Caption & " woohoo"
Debug.Print vbTab & mnuItem.Caption
Next j
Next i
'// Unfortunately, there are still two items left:
'// - Show ShapeSheet
'// - Hyperlinks...
Call Visio.ActiveDocument.SetCustomMenus(visUiObj)
'ThisDocument.SetCustomMenus uiObj
'Call Visio.Application.SetCustomMenus(visUiObj)
'// Restore the normal menus running this in the
'// Immediate window:
'Visio.ActiveDocument.ClearCustomMenus
'// Cleanup:
Set mnuItem = Nothing
Set mnu = Nothing
Set menuSetObj = Nothing
Set visUiObj = Nothing
End Sub
I have a macro that inserts Image controls on a form.
When these controls are clicked the user is asked to select an image file using the GetOpenFileName dialog box. The selected image is loaded into the control and the file path is added to column B on Sheet2.
When the Image control is clicked again the selected image is loaded to an Image control on a second form and displayed.
How do I add or attach the required code to each image control so the Click events will work?
The code I have so far is below:
Sub macroA1()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set miesto = Sheets("Sheet2").Range("B2")
strfilename = Sheets("Sheet2").Range("B2").Value
If strfilename = "" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
ElseIf strfilename = "False" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
Else
Sheets("Sheet2").Range("B2").Value = strfilename
End If
On Error Resume Next
UserForm1.Image1.Picture = LoadPicture(strfilename)
If strfilename = "False" Then
MsgBox "File Not Selected!"
Exit Sub
Else
End If
UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
UserForm1.Show
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
Each Image control on your userform will need a click event. This single event is stored within a class module and attached to each Image control on the form.
Insert a class module, name it clsLoadImage and add the code below to it.
Public WithEvents Img As MSForms.Image 'Place at very top of module (after Option Explicit though).
Private Sub Img_Click()
Dim FullPath As String
With Img
'Only load the picture if the control is empty.
If .Picture Is Nothing Then
'Get the file path for the image.
FullPath = Application.GetOpenFilename
If Len(Dir(FullPath)) = 0 Then
MsgBox "No file find.", vbOKOnly + vbCritical
Else
.Tag = FullPath 'The Tag property can store extra info such as a text string.
'Store the path in last row of Sheet2 column B.
ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1) = FullPath
.Picture = LoadPicture(FullPath)
.PictureSizeMode = fmPictureSizeModeStretch
.Parent.Repaint
End If
Else
'If the image control isn't empty load the image
'into UserForm2 using the file path stored in
'the Tag property.
Load UserForm2
With UserForm2
With .Image1
.Picture = LoadPicture(Img.Tag)
.PictureSizeMode = fmPictureSizeModeStretch
.Parent.Repaint
End With
.Show
End With
End If
End With
End Sub
Next add a UserForm to the project. In the sample code I have left it named as UserForm1. Make the Height at at least 340 and fairly wide.
Add a CommandButton near the top and an Image control near the bottom (I put the Top at 218 for the image control).
These controls probably won't be included in your final solution but give different options depending on your requirements.
Add the below code to UserForm1.
This code will fire when you open the form.
The top part of the code will attach the Click event to any existing Image controls - such as the one that's placed near the bottom.
The bottom part of the code will create an Image control for each file path listed in Sheet2 column B and attach the Click event to it.
Note: Top is set as 134 placing them in the middle area of the form.
Public ImageControls As New Collection 'Place at very top of module (after Option Explicit though).
'Could execute when the form opens.
'''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Initialize()
'Relies on image controls added at design time.
'Attaches the click event to each image control.
Dim Ctrl As Control
Set ImageControls = New Collection
Dim ImgEvent As clsLoadImage
For Each Ctrl In Me.Controls
If TypeName(Ctrl) = "Image" Then
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = Ctrl
ImageControls.Add ImgEvent
End If
Next Ctrl
''''''''''''''''''''''''''''''''''''''''''''
'Creates an image control for each file path
'in Sheet2 column B, loads the picture,
'stores the path in the tag property,
'attaches the click event.
Dim x As Long
Dim tmpCtrl As Control
For x = 2 To ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
'Add the control, name it and position it.
Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "AddedInLoop_Image_" & x)
With tmpCtrl
.Left = .Width * (x - 2)
.Top = 134
.Picture = LoadPicture(ThisWorkbook.Worksheets("Sheet2").Cells(x, 2))
.PictureSizeMode = fmPictureSizeModeStretch
.Tag = ThisWorkbook.Worksheets("Sheet2").Cells(x, 2)
End With
'Attach the Click event to the control.
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = tmpCtrl
ImageControls.Add ImgEvent
Next x
Me.Repaint
End Sub
Add this code to UserForm1 as well to deal with the CommandButton that you added.
This will add an Image control each time you press the button.
Note - Top is set at 40 so they'll appear near the top of the form.
'Creates an image control and attaches
'a Click event to the control.
Private Sub CommandButton1_Click()
Dim CtrlCount As Long
Dim Ctrl As Control
Dim tmpCtrl As Control
Dim ImgEvent As clsLoadImage
'Count the Image controls so each
'new control has a unique name.
CtrlCount = 1
For Each Ctrl In Me.Controls
'NB: The InStr command is only needed so the controls
' added in the Initalise event aren't counted.
If TypeName(Ctrl) = "Image" And InStr(Ctrl.Name, "BtnClck_Image_") > 0 Then
CtrlCount = CtrlCount + 1
End If
Next Ctrl
'Add the control, name it and position it.
Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "BtnClck_Image_" & CtrlCount)
With tmpCtrl
.Left = .Width * (CtrlCount - 1)
.Top = 40
End With
'Attach the Click event to the control.
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = tmpCtrl
ImageControls.Add ImgEvent
End Sub
Finally, add a second UserForm and add a single Image control named Image1 filling the form. I have left the form named as UserForm2.
To use:
Open UserForm1.
An Image control will be created for each full file path & name listed in column B of Sheet2. It will display the picture from the file path.
Pressing the button will create a blank Image control.
Clicking a blank Image control will open a dialog box asking you to select a file. The selected file will be loaded into the control and the file path added to column B on Sheet2.
Clicking an Image control that contains a picture will open UserForm2 with the image loaded into the Image control on that form.
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.