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?

--
Jay


"RB Smissaert" wrote:

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


"Chris Hankin" wrote in message
...
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("P3:P65000"), 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 ***