Add a custom submenu to a Chart object's submenu - excel

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

Related

Add an icon to (custom right_click menu) , Application.ShortcutMenus

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

Excel ControlButton Pasteface

I have an excel sheet that makes a custom toolbar. Within this toolbar, I have several buttons that use faceIDs, which are no problem. I have a few buttons where I wanted to use custom icons. When I use the custom icons, sometimes the PasteFace works, sometimes it does not, and I get an error. I added an On Error Resume next statement, to see what was happening. Sometimes both buttons paste ok, sometimes just one button, sometimes neither button. I can find no pattern to it working or not working.
My toolbar consists of approximately 24 buttons, and one drop down box. Eleven of the buttons use a custom icon, the remainder use a FaceID. Some buttons are toggled to display or not display based on user needs. The example below shows 2 buttons that will toggle to turn a meal penalty on or off. I only picked these 2 buttons because these are first buttons to use a custom icon.
Sub Make_PayBar()
Dim PayBar As CommandBar
Dim NewButton As CommandBarButton
'Delete existing PayBar toolbar if it exists
Call Kill_PayBar
ThisWorkbook.Activate
On Error Resume Next
'Create New PayBar
Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
PayBar.Visible = True
PayBar.Position = msoBarTop
... Missing Code, More buttons ...
'Meal Penalty Off Button
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
NewButton.Caption = "Meal Penalty Off"
NewButton.OnAction = "ToggleMeal"
'NewButton.FaceId = 1254 'Backup if pasteface fails
Sheets("Pics").Shapes("Meal_Off").Copy
NewButton.PasteFace
'Meal Penalty On Button
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_On")
NewButton.Caption = "Meal Penalty On"
NewButton.OnAction = "ToggleMeal"
'NewButton.FaceId = 1253 'Backup if pasteface fails
Sheets("Pics").Shapes("Meal_On").Copy
NewButton.PasteFace
NewButton.Visible = False
... Missing Code, More buttons ...
End sub
If the Resume Next is not used, the error may occurs on either of the two pasteface statements.
Is there something in my code making PastFace unreliable?
If PasteFace is inherently unreliable, is there a way to check for a successful paste, and repeat if it wasn't?
Is there a better way to do this?
Worksheets have hidden collections that hold pictures and ActiveX controls. The VBA also has a hidden Picture type. Pictures have a CopyPicture method that is more consistent then `Shape.Copy.
Press F2 to open the Object Browser, right click and choose Show Hidden Members
Function picMeal_Off() As Picture: Set picMeal_Off = ThisWorkbook.Worksheets("Pics").Pictures("Meal_Off"): End Function
Function picMeal_on() As Picture: Set picMeal_on = ThisWorkbook.Worksheets("Pics").Pictures("Meal_on"): End Function
Sub Make_PayBar()
Dim PayBar As CommandBar
Dim NewButton As CommandBarButton
Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
PayBar.Visible = True
PayBar.Position = msoBarTop
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
NewButton.Caption = "Meal Penalty Off"
NewButton.OnAction = "ToggleMeal"
picMeal_Off.CopyPicture
NewButton.PasteFace
End Sub
I created functions to refer to the Pictures by using this macro:
Sub PrintPitureDefs(ws As Worksheet)
Const BaseCode As String = "Function picCodeName() As Picture:Set picCodeName = ThisWorkbook.Worksheets(""WorksheetName"").Pictures(""PictureName""):End Function"
Dim Code As String
Dim Img As Picture
For Each Img In ws.Pictures
Code = Replace(BaseCode, "WorksheetName", ws.Name)
Code = Replace(Code, "PictureName", Img.Name)
Code = Replace(Code, "CodeName", Replace(Img.Name, " ", "_"))
Debug.Print Code
Next
End Sub

Add sub-menu to cell context menu in Excel in vb.net

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

get the name of the clicked menu item

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

Why can't I edit a commandbar control in Excel 2013 with VBA?

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

Resources