I have the following code that works fine for normal worksheets, but when I try to right click over a table the macro does not appear.
I have tried the below but getting "Object Required" error message on the first line:
With ContextMenuListRange.Controls.Add(Type:=msoControlButton, before:=2)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "macro"
.Caption = "macro"
.Tag = "My_Cell_Control_Tag"
End With
The below works fine with a normal worksheet.
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "macro"
.Caption = "macro"
.Tag = "My_Cell_Control_Tag"
End With
How do I get to appear when right clicking over a table?
Try adding your button to the List Range Popup shortcut menu...
With Application.CommandBars("List Range Popup").Controls.Add(Type:=msoControlButton, before:=2)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "macro"
.Caption = "macro"
.Tag = "My_Cell_Control_Tag"
End With
You can use the following macro to generate a list of all shortcut menus...
Sub ShowShortcutMenuNames()
Dim Row As Long
Dim cbar As CommandBar
Row = 1
For Each cbar In Application.CommandBars
If cbar.Type = 2 Then 'msoBarTypePopUp
Cells(Row, 1) = cbar.Index
Cells(Row, 2) = cbar.Name
Row = Row + 1
End If
Next cbar
End Sub
Hope this helps!
Related
I have a Sub that creates multiple buttons in multiple rows based on values stored on those rows. I have another Sub that I want to be assigned to each of those buttons but with a different argument for each row.
This second sub just selects the sheet whose name are given as argument.
The two subs are the following:
Sub GenerateButtons()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
For i = 1 To 78 Step 1
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "'GoToSheet " & Sheets("SheetCount").Range("A" & i).Value & "'"
.Caption = Sheets("SheetCount").Range("A" & i).Value
.Name = Sheets("SheetCount").Range("A" & i).Value
End With
Next i
Application.ScreenUpdating = True
End Sub
Sub GoToSheet(sheet As String)
Sheets(sheet).Select
End Sub
When I run the first macro, the buttons and macros are assigned to those buttons, but when I click on one of those Excel prompts an error message saying the macro "MyWorkbook.xlsm'!'GoToSheet Argument1" is not available.
I have all macros enabled and those two macros are stored in a standard module (Module1).
What is wrong with this code? If there's another way to achieve this task (buttons for each row selecting a sheet), I would appreciate to know.
Thanks in advance.
This:
.OnAction = "'GoToSheet " & Sheets("SheetCount").Range("A" & i).Value & "'"
should be
.OnAction = "'GoToSheet """ & Sheets("SheetCount").Range("A" & i).Value & """'"
http://dailydoseofexcel.com/archives/2004/06/03/passing-arguments-through-onaction/
Tested:
Sub GenerateButtons()
Dim btn As Button, i As Long, t As Range, ws As Worksheet, v
Set ws = ActiveSheet
ws.Buttons.Delete
For i = 1 To 4
Set t = ActiveSheet.Cells(i, 5)
Set btn = ws.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
v = ws.Range("A" & i).Value
With btn
.OnAction = "'GotoSheet """ & v & """'"
.Caption = v
.Name = v
End With
Next i
End Sub
Sub GotoSheet(s)
Debug.Print s
End Sub
There seems to be very little online around this, so some input here would be very useful.
I have used the below code to add an option to a right-click menu:
Private Sub Workbook_Open()
Dim MyMenu As Object
Set MyMenu = Application.ShortcutMenus(xlWorksheetCell) _
.MenuItems.AddMenu("Opportunities", 1)
With MyMenu.MenuItems
.Add "Open", "openOpportunity", , 1, , ""
.Add "Edit", "editOpportunity", , 2, , ""
End With
Set MyMenu = Nothing
End Sub
This adds an option to the right-click menu when I right-click in a cell, but when I right-click a cell in an Excel table, it doesn't appear.
Any ideas where I go next?
You also must add your options to 'List Range Popup'. I am not familiar with the way you do that and I don't know how to obtain the necessary Command bar index, so I will show you my way to do exactly what you need, in the next code:
Sub AddButContextMenu()
Dim CMenu_Cell As CommandBar, MySubMCell As CommandBarControl
Dim CMenu_Table As CommandBar, MySubMTable As CommandBarControl
'Delete the controls first, in order to avoid duplicates
Call DeleteFromCellMenu
'Set ContextMenu to the Cell menu and List Range Popup
Set CMenu_Cell = Application.CommandBars(35) 'Cell menu
Set CMenu_Table = Application.CommandBars(71) 'List Range Popup
Set MySubMCell = CMenu_Cell.Controls.Add(Type:=msoControlPopup, Before:=3)
Set MySubMTable = CMenu_Table.Controls.Add(Type:=msoControlPopup, Before:=3)
With MySubMCell
.Caption = "Opportunities"
.Tag = "My_Tag"
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "openOpportunity"
.Caption = "Open"
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "editOpportunity"
.Caption = "Edit"
End With
End With
With MySubMTable
.Caption = "Opportunities"
.Tag = "My_Tag"
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "openOpportunity"
.Caption = "Open"
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "editOpportunity"
.Caption = "Edit"
End With
End With
CMenu_Cell.Controls(4).BeginGroup = True 'add separator
CMenu_Table.Controls(4).BeginGroup = True 'add separator
End Sub
Sub DeleteFromCellMenu()
Dim ContextMCell As CommandBar, ContextMTable As CommandBar
Dim ctrl As CommandBarControl
Set ContextMCell = Application.CommandBars(35) 'Cell
Set ContextMTable = Application.CommandBars(71) 'List Range Popup
For Each ctrl In ContextMCell.Controls
If ctrl.Tag = "My_Tag" Then
ctrl.Delete
End If
Next ctrl
For Each ctrl In ContextMTable.Controls
If ctrl.Tag = "My_Tag" Then
ctrl.Delete
End If
Next ctrl
End Sub
If interested, I can show you a method to identify all shortcut menus...
I have write a script which display specific scripts in the context menu.
After programming, the contextmenu displays the scripts I want to launch, and the scripts runs well.
'SCRIPT POUR MENU CONTEXTUEL
Sub AddToCellMenu()
Dim ContextMenu As CommandBar
Dim MySubMenu As CommandBarControl
' Delete the controls first to avoid duplicates.
Call DeleteFromCellMenu
' Set ContextMenu to the Cell context menu.
Set ContextMenu = Application.CommandBars("Cell")
' Add one custom button to the Cell context menu "BL OK".
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=20)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Bouton_BonLivraisonOK"
.FaceId = 71
.Caption = "Bon Livraison OK"
.Tag = "My_Cell_Control_Tag"
End With
' Add one custom button to the Cell context menu "LIVRAISON OK".
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=21)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Bouton_LivraisonOK"
.FaceId = 72
.Caption = "Expédition OK"
.Tag = "My_Cell_Control_Tag"
End With
' Add one custom button to the Cell context menu "Livraison avec RELIQUAT".
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=22)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Bouton_LivraisonReliquat"
.FaceId = 73
.Caption = "Expédition avec RELIQUAT"
.Tag = "My_Cell_Control_Tag"
End With
' Add one custom button to the Cell context menu "RAZ".
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=23)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "Bouton_CellBlank"
.FaceId = 70
.Caption = "RAZ"
.Tag = "My_Cell_Control_Tag"
End With
' Add a separator to the Cell context menu.
ContextMenu.Controls(20).BeginGroup = True
End Sub
The problem is the contextmenu is still running in other excel files after closing the file.
I need your help for closing the function in contextmenu when I work on other Excel file.
Sub DeleteFromCellMenu()
Dim ContextMenu As CommandBar
Dim ctrl As CommandBarControl
' Set ContextMenu to the Cell context menu.
Set ContextMenu = Application.CommandBars("Cell")
' Delete the custom controls with the Tag : My_Cell_Control_Tag.
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = "My_Cell_Control_Tag" Then
ctrl.Delete
End If
Next ctrl
' Delete the custom built-in Save button.
On Error Resume Next
ContextMenu.FindControl(ID:=3).Delete
On Error GoTo 0
End Sub
I found the solution.
I have to declare the opening/closing of CellMenu in the workbook.
Please refer to the following code:
Private Sub Workbook_Activate()
Call AddToCellMenu
End Sub
Private Sub Workbook_Deactivate()
Call DeleteFromCellMenu
End Subenter code here
I have created an AddIn that utilizes an extensive menu system to call code based on the worksheet name the user is working in. Some of these worksheets are in different workbooks. All of the individual subs work, but I am having difficulty in figuring out why the menu (a button in the Ribbon triggers the menu code) only works once, then gives me a
Run-time error '5': Invalid procedure call or argument
The button triggers this code to run:
Sub CreateMasterMenu()
'
Select Case ActiveSheet.name
Case "BCM Hourly Comparison an": Call Extract_Initial_Save
Case "Daily Impacts Verification Step": Call Verification_Initial_Save
Case "Extract": Call Extract_Menu
Case "Swivel": Call Swivel_Menu
Case "Disputed": Call Disputed_Menu
Case "Verification": Call Verification_Menu
Case Else: MsgBox "There are no menu options available for this worksheet."
End Select
On Error Resume Next
Application.CommandBars(Menuname).ShowPopup
On Error GoTo 0
End Sub
This will call a popup menu based on the name of the active worksheet. When I first open the workbook and make a choice, it works as expected. But when I click on the button a second time to make another choice, I receive the RT error.
Sub Swivel_Menu()
'
Dim MenuItem As CommandBarPopup
With Application.CommandBars.Add(name:=Menuname, Position:=msoBarPopup, _
MenuBar:=False, Temporary:=True) 'This is where the debugger says the error is
With .Controls.Add(Type:=msoControlButton)
.Caption = "Hide Columns"
.FaceId = 1649
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_Hide_Columns"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Highlight & Copy Disputed"
.FaceId = 3881
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_HandC_Disputed"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Swivel Sheet Sort"
.FaceId = 706
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_Sheet_sort"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Unhide Columns"
.FaceId = 1650
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_Unhide_Columns"
End With
Set MenuItem = .Controls.Add(Type:=msoControlPopup)
With MenuItem
.Caption = "Swivel Tools"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Remove Duplicates"
.FaceId = 2165
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_Remove_Duplicates"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Copy To Validate"
.FaceId = 731
.OnAction = "'" & ThisWorkbook.name & "'!" & "Swivel_Copy_To_Validate"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Not Available"
.FaceId = 463
.OnAction = "'" & ThisWorkbook.name & "'!" & "Menu_Construct_Msg"
End With
End With
End With
End Sub
I had this code running from a workbook and did not have this issue. It is pretty much copied into the add-in (with extra menu options added), but the code is the same.
Am I getting this error because I am running it from an add-in as opposed to running it from the workbook as before?
How do I make one of the menu items open a hyperlink?
For example say Button 1 when selected in the menu opens "www.google.com" and Button 2 opens "www.yahoo.com" instead of test Macro. I tried changing the .OnAction to .FollowHyperlink.
I even tried just entering the hyperlink in the .OnAction section with no luck.
Any advice?
Option Explicit
Public Const Mname As String = "MyPopUpMenu"
Sub DeletePopUpMenu()
' Delete the popup menu if it already exists.
On Error Resume Next
Application.CommandBars(Mname).Delete
On Error GoTo 0
End Sub
Sub CreateDisplayPopUpMenu()
' Delete any existing popup menu.
Call DeletePopUpMenu
' Create the popup menu.
Call Custom_PopUpMenu_1
' Display the popup menu.
On Error Resume Next
Application.CommandBars(Mname).ShowPopup
On Error GoTo 0
End Sub
Sub Custom_PopUpMenu_1()
Dim MenuItem As CommandBarPopup
' Add the popup menu.
With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _
MenuBar:=False, Temporary:=True)
' First, add two buttons to the menu.
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 1"
.FaceId = 71
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 2"
.FaceId = 72
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
End With
' Next, add a menu that contains two buttons.
Set MenuItem = .Controls.Add(Type:=msoControlPopup)
With MenuItem
.Caption = "My Special Menu"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 1 in menu"
.FaceId = 71
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 2 in menu"
.FaceId = 72
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
End With
End With
' Finally, add a single button.
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 3"
.FaceId = 73
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
End With
End With
End Sub
Sub TestMacro()
MsgBox "Hi there!"
End Sub
You can put
ThisWorkbook.FollowHyperlink "http://......"
In your TestMacro
If you are going to use this as a method of launching hyperlinks, add a parameter to the Testmacro sub procedure.
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(1)"
...
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(2)"
...
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(3)"
The actual TestMacro sub would institute a Select Case statement to handle all of the menu commands.
Sub TestMacro(Optional iTYP As Long = 1)
Select Case iTYP
Case 1
MsgBox "option 1"
ActiveWorkbook.FollowHyperlink "http://www.google.com"
Case 2
MsgBox "option 2"
ActiveWorkbook.FollowHyperlink "http://www.yahoo.com"
Case 3
MsgBox "option 3"
ActiveWorkbook.FollowHyperlink "http://www.bing.com"
Case Else
ActiveWorkbook.FollowHyperlink "http://stackoverflow.com"
End Select
End Sub
as with Bas answer you can set your TestMacro to have an input string for the url and then pass that when calling it
' Finally, add a single button.
With .Controls.Add(Type:=msoControlButton)
.Caption = "Button 3"
.FaceId = 73
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(" & Chr(34) & "http://www.google.com" & Chr(34) & ")"
End With
Sub TestMacro(url As String)
ThisWorkbook.FollowHyperlink url
End Sub