Please, try using the next solution:
- Copy the next event code in
ThisWorkbook
code module. If you already use Open
event, include in it the single code line from below. It will at a control ("Open document") in the format cell context menu:
Private Sub Workbook_Open()
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add "Open document", "OpenDocument", , 1, , ""
End Sub
Take also care of eliminating the option from the context menu:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ShortcutMenus(xlWorksheetCell).MenuItems("Open document").Delete
End Sub
- Copy the called
Sub
code in a standard module:
Sub OpenDocument()
If Selection.Columns.count > 1 Then Exit Sub
Dim cel As Range, El, arrCel, objShell As Object
Set objShell = CreateObject("Shell.Application")
For Each cel In Selection.cells
If cel.Hyperlinks.count > 0 Then
objShell.Open (cel.Hyperlinks(1).address)
Else
arrCel = Split(cel.Value, vbLf)
For Each El In arrCel
objShell.Open (El)
Next El
End If
Next cel
End Sub
Edited:
This is a new version using ShellExecute
, which (maybe) will be able to open the document in the default application:
Sub OpenDocument() 'ShellExecute
If Selection.Columns.count > 1 Then Exit Sub
Dim cel As Range, El, arrCel
For Each cel In Selection.cells
If cel.Hyperlinks.count > 0 Then
ShellExecute 0, "open", (cel.Hyperlinks(1).address), "", "", 1
Else
arrCel = Split(cel.Value, vbLf)
For Each El In arrCel
ShellExecute 0, "open", (El), "", "", 1
Next El
End If
Next cel
End Sub
The necessary API declaration (to be placed on top of the module where the above Sub
exists:
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
The above declaration is for 64 bit installations. It can be easily adapted to work for 32 bit, too, but let us see that it does what you need...