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
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'm setting up an Excel worksheet where I need to dynamically generate Active-X buttons and set up a different action for each one.
I get
run time error 459 "Object or class does not support the class of events"
when I launch it.
I've seen similar questions but the solutions have been given for userforms.
My current solution.
I have a custom class module WoExp_FSelect_Btn:
Public WithEvents btn As OLEObject
Public id As Integer
Dim iCount As Long
' Action to handle button click
Private Sub btn_Click()
'*** just for debug: show msgbox with id
MsgBox ("ID: " & id) 'Debug
End Sub
A collection is created with global scope to fit this kind of objects:
Public WoExp_DFileSel_Buttons As New Collection
Then I dynamically create the buttons running the following function inside a loop, i being the loop iteration:
Private Sub WoExp_AddFileSel_Btn(i As Integer)
Dim cmdbtn As OLEObject
Dim FselBtnWithEvents As WoExp_FSelect_Btn
Set cmdbtn = Worksheets("Word Report Gen").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=50, Top:=80, Width:=75, _
Height:=30)
cmdbtn.Left = Worksheets("Word Report Gen").Cells(13 + i, 3).Left
cmdbtn.Top = Worksheets("Word Report Gen").Cells(13 + i, 3).Top
cmdbtn.Name = "WoExpDFileSel_Btn_" + CStr(i)
Set FselBtnWithEvents = New WoExp_FSelect_Btn
Set FselBtnWithEvents.btn = cmdbtn
FselBtnWithEvents.id = i
WoExp_DFileSel_Buttons.Add FselBtnWithEvents
End Sub
All buttons are properly shown if I comment the Set FselBtnWithEvents.btn = cmdbtn line, so I think that the problem is that OLEobject class and WithEvents don't go along.
As the error states, the OLEObject object does not support the Click event. If you go to your class module, select btn from the Object dropdown menu, and then click on the Procedure dropdown menu, you'll see that it only supports GotFocus and LostFocus.
However, when I replaced the Click event with either GotFocus or LostFocus, the same error occurred. So maybe there's some sort of bug.
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
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