Popup Menus Help Please

[Chris Hankin]

Hello,

Could someone please help me with the following?

My code below allows a user to right-click on any cell in column P to
open up a specific folder and select an Excel spreadsheet in that
folder. A hyperlink is then added to the cell that was originally
right-clicked on to the Excel spreadsheet.

The macro code below works fine, however I keep getting two annoying
pop-up menus.

The first pop-up menu shows the following selections:

Explore
WinZip
Send To
Properties

At this pop-up menu I press the Esc key to close it.

After selecting the required Excel spreadsheet, the hyperlink is created
in the selected cell and then the second pop-up menu appears with the
following selections:

Cut
Copy
Paste
Paste Special
Insert
Delete
Clear Contents
Insert Comment
Format Cells
Pick from Drop-down List
Add Watch
Create List
Hyperlink
Look Up

Again, at this pop-up menu I press the Esc key to close it.

Could someone please advise on how I can automatically cancel these
pop-up menus by adding the appropriate VBA code into my macro below?

Any help would be greatly appreciated.

Kind regards,

Chris.


Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range,
Cancel As Boolean)
Dim fileToOpen As String
Dim MyPath As String
Dim SaveDriveDir As String

Application.ScreenUpdating = False

If Not Application.Intersect(Range("P365000"), Target) Is Nothing
Then
SaveDriveDir = CurDir
MyPath = "G:\WLMAEWCSPO\LMU\LOGISTICS PREPAREDNESS SYSTEMS\LOGPREP
SYS\CODIFICATION\SPREADSHEETS\"
ChDrive MyPath
ChDir MyPath

fileToOpen = Application _
.GetOpenFilename("XLS Files (*.xls), *.xlt", , "Link to File")
If fileToOpen = "False" Then Exit Sub
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fileToOpen
ChDrive SaveDriveDir
ChDir SaveDriveDir
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.Offset(0, 1).Range("A1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
ActiveCell.Offset(0, -1).Range("A1").Select
Else: Exit Sub
End If

End Sub



*** Sent via Developersdex http://www.developersdex.com ***

 

[RB Smissaert]

I think you want something like this:

Dim oCtrl As Object

With Application.CommandBars("Cell")

'Clear the existing menus
For Each oCtrl In .Controls
oCtrl.Delete
Next oCtrl

End With


RBS

 

[Jay]

1. To disable the second shortcut menu that appears, add this line
immediately after your "If Not.... Then" line:
CommandBars("Cell").Enabled = False ' set enabled back to True where
appropriate.

2. The first shortcut menu is a little more stubborn and I don't really have
a solution for you at the moment. It looks to me like the GetOpenFilename
method passes the righ-click out to the Windows API for some reason; the
shortcut menu is an artifact of the Windows environment. We need to kill the
right-click somehow after your event fires. Anybody else have any experience
with this?

 

[Chris Hankin]

Thanks so much both Jay and RB Smissaert - your codes work very well.
Again, thanks for all your hard work and efforts, they are greatly
appreciated.

Cheers,

Chris.


*** Sent via Developersdex http://www.developersdex.com ***

 

[Chris Hankin]

Please help with unexpected side-effect after running the following
codes:

Dim oCtrl As Object

With Application.CommandBars("Cell")

'Clear the existing menus
For Each oCtrl In .Controls
oCtrl.Delete
Next oCtrl

End With

and

CommandBars("Cell").Enabled = False

When I right-click on any cell in my worksheet, I am unable to bring up
a command pop-up menu. What I get is a small blue-coloured rectangle
instead of a command pop-up menu. I then press the Esc - key to remove
the blue-coloured rectangle.

I also tried the following code to try to set my command menus back to
normal:

CommandBars("Cell").Enabled = True

However, this seems to have no affect and I still keep getting the same
blue-coloured rectangles.

I even tried right-clicking on a new worksheet and the same
blue-coloured rectangle keep appearing.

Could some please advise on how I can reverse this situation?

Kind regards,

Chris.




*** Sent via Developersdex http://www.developersdex.com ***

 

[Jay]

Hi again Chris -

To solve the problem immediately:

If you used the following to turn off the shortcut menu, type the following
into the VBA Immediate Window (and press Enter to run it):
CommandBars("Cell").Enabled = True

If you used the oCtl.Delete approach to turn off the shortcut menu, type the
following into the VBA Immediate Window (and press Enter to run it):
CommandBars("Cell").Reset

 

[NickHK]

Chris,
With neither W2K/XL2002 nor W2K/XL2K do I get that first Windows pop up at
all.
As for the 2nd "Cell" pop up, can't you just add a
Cancel=True
to cancel Excel's default right-click response ?

NickHK

 

[Jay]

NickHK and Chris -

NickHK's Cancel=True suggestion works perfectly when inserted right after
the '....getopenfilename...' statement. It's likely the preferred solution
because you don't have to re-enable.

Also, be careful with the ..oCtrl.Delete.. approach. If the menu you are
deleting has been customized at some point, a simple
Commandbars("Cell").Reset will restore it, but not to its customized state.
The Enable=True/False approach restores the menu to its normal state
(customized or not).

And finally, I still cannot reproduce the in first menu that appears. I'm
using WinXP/XL2003.

 

[Chris Hankin]

Thanks for all your great advice NickHK and Jay - really nice work.
Your efforts are greatly appreciated.

Cheers,

Chris.

Live Long and Prosper

*** Sent via Developersdex http://www.developersdex.com ***