Sub object_border_remove() Selection.ShapeRange.Line.Visible = msoFalse End Sub Sub object_fill_transparent() Selection.ShapeRange.Fill.Visible = msoFalse End SubCould someone tell me how to add these 2 options to the shortcut menu? If possible, I would want to create logic that would first check to see if an object has been selected. If it has, it would add the 2 above options. Thank you in advance.
VB:CreateCmdBar() Dim st As CommandBar 'delete the pop-up if it exists On Error Resume Next Application.CommandBars("flexgrid_rc").Delete 'Disables enabled error handler in the current procedure and resets it to Nothing. On Error GoTo 0 On Error Goto 0 Set st = CommandBars.Add(Name:="flexgrid_rc", Position:=msoBarPopup, Temporary:=False) 'add two menu items to the new commandbar With st .Controls.Add Type:=msoControlButton 'assign captions to the menu items and OnActions .Controls(1).Caption = "Edit" 'please note that the following OnAction macros would have to be created .Controls(1).OnAction = "test2" End With st.Enabled = True End Sub Sub test2() MsgBox "test" End Sub Private Sub UserForm_Initialize() CreateCmdBar End Sub Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 2 Then CommandBars("flexgrid_rc").ShowPopup End If End SubIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Sub Worksheet_BeforeRightClick(ByVal Target As Range, _ Cancel As Boolean) For Each icbc In Application.CommandBars("cell").Controls If icbc.Tag = "brccm" Then icbc.Delete Next icbc With Application.CommandBars("cell").Controls _ .Add(Type:=msoControlButton, before:=6, _ temporary:=True) .Caption = "Open in AutoVue" .OnAction = "GetDrawing" .Tag = "brccm" End With End SubThe problem is that the rightclick code above isn't really what's being run and I'm really confused by that. I had changed the "temporary:=True" above to false, and saved everything as an addin (.xla file) to see if it would easily port to other machines. My memory of the exact sequence of events is hazy, so I can't give an accurate timeline of what I did when. I think that when I mucked around with the temporary true/false setting, it got applied to some other persistent location that I can't find. My symptoms are as follows: any changes to the rightclick code above do not affect the project (I can change caption:= to "Change change change" and the rightclick menu item still has the caption "Open in AutoVue"), removing the personal.xls file from the XLSTART folder does not remove the rightclick menu item, and removing the .xla file from the ...MicrosoftAddins folder doesn't get rid of it either.
VB:Ignore the fact that none of the macro links work, if you just paste this into a new module you should be able to see what I meanCreateMenuTest() Dim cbcRightClick As CommandBarControl Set cbcRightClick = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup) ' Give the control a caption and sets the "isRightclick" variable to "True" cbcRightClick.Caption = "Useful Macros List" Const ArrayNum = 9 'Add number here to increase array size and add a new macro Dim NameArray(ArrayNum) As String 'Array to hold button names Dim MacroArray(ArrayNum) As String 'Array to hold macro names Dim ButtonCount As Integer 'Counter for adding buttons 'This loops through the 2 arrays adding the names and macro links to each entry For ButtonCount = 1 To ArrayNum NameArray(ButtonCount) = Choose(ButtonCount, _ "Add/Remove Negative Values", _ "Lock/Protect Formulae", _ "Locate/Remove Blanks", _ "Highlight Duplicate Entries", _ "Prevent Duplicate Entries", _ "Fix Dates", _ "Find/Break External Links", _ "Accounting Bracketed Negatives", _ "Trim Cells (Removes blanks within cells)" _ ) MacroArray(ButtonCount) = Choose(ButtonCount, _ "Manipulating_Negatives", _ "Lock_Formulae", _ "Remove_Blanks", _ "Highlight_Duplicates", _ "Prevent_Duplicates", _ "Convert_To_Date", _ "Break_Links", _ "AccountingNegativesInBrackets", _ "Trim_Blanks" _ ) Next ButtonCount 'End of loop adding data to arrays 'Loop to add the buttons to the right click cell drop down menu For ButtonCount = 1 To ArrayNum With cbcRightClick.Controls.Add .Caption = NameArray(ButtonCount) .OnAction = MacroArray(ButtonCount) End With Next ButtonCount End Sub Sub DeleteTestMenu() On Error Resume Next Application.CommandBars("Cell").Controls("Useful Macros List").Delete On Error Goto 0 End SubIf you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines