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 ***

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 ***

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 ***

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 ***

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 ***

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
----------------------------------------------
Insert either of these lines (as appropriate) at a strategic location in
your VBA code, such as in the Workbook_Close module (or sooner), so that the
menus will be re-enabled as soon as you're done with your application.

--
Jay

--
Jay


"Chris Hankin" wrote:

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 ***

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

"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 ***

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.

--
Jay


"NickHK" wrote:

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

"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 ***

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 ***