Is there any way to get the name of the clicked menu item?
I have created a new add-in file with menus and sub-menus. Can I get the name of the sub-menu which I clicked to be used inside the macro?
For example:
Sub Auto_Open()
Dim NewControl As CommandBarPopup
Dim mItem, SubMenu
On Error Resume Next
Call Auto_Close
Set NewControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, temporary:=True)
NewControl.Caption = "&Menu"
Set mItem = NewControl.Controls.Add(Type:=msoControlButton)
With mItem
.Caption = "Sub-Menu1"
.OnAction = "submenu1"
End With
Set mItem = NewControl.Controls.Add(Type:=msoControlButton)
With mItem
.Caption = "Sub-Menu2"
.OnAction = "submenu2"
End With
Set mItem = NewControl.Controls.Add(Type:=msoControlButton)
With mItem
.Caption = "Sub-Menu3"
.OnAction = "submenu3"
End With
On Error GoTo 0
End Sub
So the above code creates an Add-In ribbon with button "Menu" and sub-Menus "Sub-Menu1, Sub-Menu2 and Sub-Menu3".
If I click any of the sub menus I need a message box displaying the name of the menu I clicked.
The ActionControl property of the Commandbars object will tell you which menu item was clicked to call your code.
Dim ctl As CommandBarControl
Set ctl = Application.Commandbars.ActionControl
Related
I am using this code to add an entry to excel right_click menu:
Private Sub Workbook_Open()
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add "Open document", "OpenDocument", , 1, , ""
End Sub
Sub OpenDocument()
‘vba code here
End Sub
I need to add an icon to this entry (using shell32.dl or any standalone image), as it is now blank.
Your requirement can be solved in more ways, but (at least, this is what I know how to handle) using a different approach (CommandBar):
To place a custom picture, please try the first version. It uses a picture from a specific path:
Sub AddItemContextMenuWithImage_1()
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton, picPicture As IPictureDisp
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
Set picPicture = stdole.StdFunctions.LoadPicture(ThisWorkbook.Path & "\test.gif") 'accepted extensions: bmp, jpg, gif
With ctrlButt
.Picture = picPicture
.OnAction = calledProc
.Caption = butName
End With
End Sub
To check it, the demonstative Sub should look as:
Sub testSubX()
MsgBox "It works..."
End Sub
Of course, you may adapt the code to call your own/necessary Sub...
A second version uses/copies a picture already added on a specific sheet of ThisWorkbook:
Sub AddItemContextMenuWithImage_2()
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
ActiveSheet.Pictures("Picture 2").Copy 'need to have a "Picture 2" picture on the active sheet
'you can copy it as image of the newly added control button
With ctrlButt
.PasteFace 'paste the above copied picture
.OnAction = calledProc
.Caption = butName
End With
End Sub
The third version uses standard, already defined FaceIDs. There are so many, that it is very probable to find something suitable for your need, so this is the version I prefer:
Sub AddItemContextMenuWithImage_3()
'Here the list of FaceID controls with their images:
'https://bettersolutions.com/vba/ribbon/face-ids-2003.htm
Const butName As String = "Open document"
Const calledProc As String = "testSubX"
deleteCellCustomControl butName
Dim cmBar As CommandBar, ctrlButt As CommandBarButton
Set cmBar = Application.CommandBars("Cell")
Set ctrlButt = cmBar.Controls.Add(Type:=msoControlButton, Before:=1) 'create it to be the first menu option
With ctrlButt
.FaceId = 1661
.OnAction = calledProc
.Caption = butName
End With
End Sub
A lot of such FaceIDs can be found here. I also place the link as a comment inside the Sub, to remain there for people being interested in this approach...
All the above Subs firstly call the next Sub, to preliminarily delete the menu option, if it already exists:
Sub deleteCellCustomControl(strBut As String)
On Error Resume Next 'for the case of not existing button to be deleted...
Application.ShortcutMenus(xlWorksheetCell).MenuItems(strBut).Delete
On Error GoTo 0
End Sub
If there is only such a custom option in the context menu, or if you want deleting all of them (the custom once), you can simple reset the command Bar, using:
Private Sub ResetContextMenuBar()
Application.CommandBars("Cell").Reset
End Sub
Header
I know how to add a submenu (control) in the commandBars("Cell"), and it's perfect! When I right-click on a cell in Excel, my submenu appears.
Question
But when I want to add a submenu in a commandBars("Chart"), the control is added and exists in the commandBars("Chart"), but it doesn't show up when I right click on the char object!!!!
Can you help me, I can not progress on this problem?
Code :
Private Sub SubAddSubmenuInChart()
Dim memObj_CdeBar As CommandBar
Dim memObj_CdeBarCtrl As CommandBarControl
Set memObj_CdeBar = ThisWorkbook.Application.CommandBars("Chart") 'or "Plot aera", etc ...
Set memObj_CdeBarCtrl = memObj_CdeBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
With memObj_CdeBarCtrl
'.OnAction = "MyMacroX"
.Enabled = True
.Visible = True
.Priority = 1
.Caption = "BBB_Test"
.Tag = "Tag_001"
End With
End Sub
I made an add-in for excel in vb.net
I want to add some shortcuts to the cell context menu. I manage to find a solution here to add button
https://social.msdn.microsoft.com/Forums/en-US/ae7a6cdd-db2c-4edd-a62a-ac35a466ae5c/how-to-assign-a-method-to-a-commandbarbutton-in-a-cell-contextmenu-in-an-vsto-application-addin-for?forum=vsto
But I can't manage to add a submenu and put these buttons inside
Here is my actual code
I manage to have the submenu and button separated, but not the buttons into the sub menu
Private WithEvents buttonVL03N As CommandBarButton
Private WithEvents buttonIW53 As CommandBarButton
Private Sub ThisAddIn_Startup() Handles Me.Startup
Dim rcCellContextMenu As CommandBar = Globals.ThisAddIn.Application.CommandBars("Cell")
Dim myMenu As CommandBarPopup
myMenu = TryCast(rcCellContextMenu.Controls.Add(MsoControlType.msoControlPopup, Before:=3), CommandBarPopup)
myMenu.Caption = "SAP Transactions"
myMenu.Tag = "SAP shortcuts "
buttonVL03N = TryCast(rcCellContextMenu.Controls.Add(MsoControlType.msoControlButton, Id:=1, Before:=3, Temporary:=True), CommandBarButton)
buttonIW53 = TryCast(rcCellContextMenu.Controls.Add(MsoControlType.msoControlButton, Id:=1, Before:=4, Temporary:=True), CommandBarButton)
If buttonVL03N IsNot Nothing Then
buttonVL03N.Caption = "VL03N"
buttonVL03N.BeginGroup = False
buttonVL03N.Tag = "Run VL03N"
buttonVL03N.Enabled = True
End If
If buttonIW53 IsNot Nothing Then
With buttonIW53
.Caption = "IW53"
.BeginGroup = False
.Tag = "Run IW53"
.Enabled = True
End With
End If
End Sub
and I tried the following
buttonVL03N = TryCast(myMenu.Controls.Add(MsoControlType.msoControlButton, Id:=1, Before:=3, Temporary:=True), CommandBarButton)
but obviously this is not as simple
buttonVL03N = TryCast(myMenu.CommandBar.Controls.Add(MsoControlType.msoControlButton, Id:=1, Temporary:=True), CommandBarButton)
buttonIW53 = TryCast(myMenu.CommandBar.Controls.Add(MsoControlType.msoControlButton, Id:=1, Temporary:=True), CommandBarButton)
is working fine
OK so I have working code, however the browser for adding files shows up in the background. This wouldn't be so bad but it freezes outlook when this happens making it difficult to get to quickly.
I'm trying to figure out how to make the popup browser show on top of everything so it's not buried. Also it is incredibly slow so if there is a more efficient way, that would be great as well. Here is what I have so far.
Option Explicit
Private Sub AttachmentFile()
Dim oLook As Object
Dim oMail As Object
Dim FD As Object
Dim vrtSelectedItem As Variant
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)
Set FD = Excel.Application.FileDialog(3)
With oMail
FD.AllowMultiSelect = True
FD.Filters.Clear
FD.Filters.Add "All Files", "*.*"
FD.InitialFileName = "\\ad\dfs\Shared Data\"
If FD.Show = True Then
For Each vrtSelectedItem In FD.SelectedItems
.Attachments.Add vrtSelectedItem
Next
End If
.Display
End With
Set FD = Nothing
Set oMail = Nothing
Set oLook = Nothing
End Sub
Although there is no FileDialog object in Outlook you may simulate pressing a button with ExecuteMso.
To open the Outlook Insert File dialog press the AttachFile button:
Private Sub ExecuteMso_AttachFile()
Dim currItem As Object
On Error Resume Next
Set currItem = ActiveInspector.currentItem
On Error GoTo 0
If currItem Is Nothing Then Set currItem = CreateItem(olMailItem)
currItem.Display
' Hover over the icon that you would add as a button
' The IdMso to use in ExecuteMso is the last part of the text displayed.
ActiveInspector.CommandBars.ExecuteMso ("AttachFile")
End Sub
I'm trying to make my own drill-through action for PivotTable by means of VBA.
The action will be called from context menu of a PivotTable from Additional Actions.
I want to put my button under Additional Actions control of PivotTable Context Menu command bar.
The point is that by default Additional Actions already contains (No Actions Defined) item.
So, I want to remove this (No Actions Defined) after adding my button, but nothing works.
I cannot even change any property of (No Actions Defined) control, like Caption, Visible, etc.
What might be the reason, and what is the workaround?
Here is my code so far (you can put it under Workbook_SheetBeforeRightClick, for example, and then test with any Pivot Table in that workbook):
Dim PCell As PivotCell
Dim PComBar As CommandBar
Dim PControl As CommandBarControl
Dim DControl As CommandBarControl
Dim BControl As CommandBarControl
Dim IsFromPivotTable As Boolean
IsFromPivotTable = False
On Error GoTo NotFromPivot
Set PCell = Target.PivotCell
IsFromPivotTable = True
NotFromPivot:
On Error GoTo 0
If IsFromPivotTable Then
Set PComBar = Application.CommandBars("PivotTable Context Menu")
Set PControl = PComBar.Controls("Additional Actions")
On Error Resume Next
With PControl
Call .Controls("My Drillthrough Action").Delete
.Enabled = True
End With
On Error GoTo 0
Set DControl = PControl.Controls.Add(Type:=msoControlButton, Temporary:=True, Before:=1)
With DControl
.Style = msoButtonIconAndCaption
.Caption = "My Drillthrough Action"
.FaceId = 786
End With
On Error Resume Next
Set BControl = PControl.Controls("(No Actions Defined)")
With BControl 'This does not work and throws error if do not suppress with On Error
.Enabled = True
.Visible = False
.Caption = "Hello there"
End With
On Error GoTo 0
End If
So, the last section With BControl ... End With does not work at all, and throws an error "Automation Error".
I can successfully edit Additional Actions itself, like enable it, but I would like to get rid of (No Actions Defined) control, or replace it with my own.
Note, that Call .Controls("(No Actions Defined)").Delete does not work either.
How can I do that?
I tried to google the problem, but no luck...
I suspect you can't add to that menu. You could, however, add to the context menu itself:
Sub test()
Dim PCell As PivotCell
Dim PComBar As CommandBar
Dim DControl As CommandBarControl
Dim target As Excel.Range
Set target = ActiveCell
On Error Resume Next
Set PCell = ActiveCell.PivotCell
On Error GoTo 0
If Not PCell Is Nothing Then
Set PComBar = Application.CommandBars("PivotTable Context Menu")
Set DControl = PComBar.Controls.Add(Type:=msoControlButton, Temporary:=True, Before:=1)
With DControl
.Style = msoButtonIconAndCaption
.Caption = "My Drillthrough Action"
.FaceId = 786
End With
End If
End Sub