0

With regarding to this question Link
So, instead of the normal way of clicking on hyperlink, I need the following:
1- add a custom right_click menu, to open hyperlinks using VBA methods.
2- The document in discussion are (.Doc .pdf .Xls .Jpg .Zip extension files) to avoid any warning messages raised by hyperlink clicking.
3- if possible that custom menu appears only while right click on specific columns.
4- if possible the command of open the document appears on the main right_click menu (not as a sub menu).
5- using right-click to open multiple Hyperlinks (surely,each cell will contain one Hyperlink)

Private Sub Workbook_Open()
 
    Dim MyMenu As Object
 
    Set MyMenu = Application.ShortcutMenus(xlWorksheetCell) _
        .MenuItems.AddMenu("Open document", 1)
 
    With MyMenu.MenuItems
        .Add "MyMacro1", "MyMacro1", , 1, , ""
    End With
 
    Set MyMenu = Nothing
 
End Sub
Waleed
  • 847
  • 1
  • 4
  • 18
  • 1. OK; 2. The document type should be selected in the called `Sub`; 3. Not possible, but you can solve this aspect in the called `Sub`; 4. Simple to be done. But this approach makes sense **only if the answer involving `BeforeDoubleClick` event also works**... Only if it looks more elegant for you. – FaneDuru Jan 18 '23 at 11:02
  • @FaneDuru ,please this is an additional request to **make/adapt** right-click to open multiple Hyperlinks (surely,each cell will contain one Hyperlink).I have replied to you on the previous question. – Waleed Jan 19 '23 at 06:12
  • I am afraid I cannot get you... What "to open multiple Hyperlinks" should mean? Should the code open all hyperlinks **from the respective column**? Should such a cell contain many lines `VbLF` separated and you need to open all their documents? Or what? – FaneDuru Jan 19 '23 at 08:02
  • I mean that I can step on many cells and do right-click to open the hyperlink inside each cell sequentially on one click. The respective cells does not contain many lines `vblf`, But **Text to Display** of the hyperlinks contain `vblf` – Waleed Jan 19 '23 at 08:41
  • I cannot understand what you mean by "The respective cells does not contain many lines `vblf`, But **Text to Display** of the hyperlinks contain `vblf`"... Is there a difference between a cell value and Text to Display of a cell containing a hyperlink? Then, supposing that it exists and I cannot understand the issue, how do you like the code to proceed for such a case? To process all such lines, if more than one? – FaneDuru Jan 19 '23 at 09:01
  • Please see this picture, in actual workbook (Text to display) contains `vblf` , I really don't know is `address= cell.value` or not https://ibb.co/1GWSFCW – Waleed Jan 19 '23 at 09:13
  • @FaneDuru "Text to Display" is exactly what the cell displays... Meaning its value. But how can you place such text to display on more than one line? Besides that, the code should process cells containing lines targeting files on their path, even if there are hyperlinks inserted or not. That's why I was thinking to let te code processing cells having more than such a line. – FaneDuru Jan 19 '23 at 09:22
  • @FaneDure `GiveMeURL = rng.Hyperlinks(1).Address` – Waleed Jan 19 '23 at 09:33
  • @FaneDure And what `rng.value` does return? Of course, speaking about a single cell range (as in the hyperlink case, too)... – FaneDuru Jan 19 '23 at 09:38

1 Answers1

2

Please, try using the next solution:

  1. 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
  1. 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...

FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • Comments are not for extended discussion; this conversation has been [moved to chat](https://chat.stackoverflow.com/rooms/251323/discussion-on-answer-by-faneduru-adding-a-custom-right-click-menu-to-open-hyper). – Machavity Jan 22 '23 at 13:54
  • @Waleed Did you refresh the page (this one)? I adapted the above answer splitting the called `Sub` part in two (a. and b.). Then, you can try the last function on both cases (I mean `Shell` or `ShellExecute`). Not being able to test, I do not know which of them works better. Or even works... – FaneDuru Jan 23 '23 at 07:33
  • I found this simple code on this [LINK](https://stackoverflow.com/questions/18921168/how-can-excel-vba-open-file-using-default-application) ,this answer with highest score `Sub runit() Dim Shex As Object Set Shex = CreateObject("Shell.Application") tgtfile = "C:\Nax\dud.txt" Shex.Open (tgtfile) End Sub` I tried that code with local hyperlinks on my home PC and found it works. kindly could you adapt it as my requirements on my question. – Waleed Jan 24 '23 at 16:51
  • @Waleed I also tried this version, but I posted one about people said it is able to deal with URLs. It will open the file in its default application. Please, test the updated code. – FaneDuru Jan 24 '23 at 20:24
  • with all local hyperlinks it works correctly as expected. about URL, I found an (online PDF URL sample) [Link](https://www.africau.edu/images/default/sample.pdf) , it works as hyperlink on own excel correctly, But when I tried to use the updated code,I got this error `The parameter is incorrect` as this [screenshot](https://imgbox.com/8QihY3ln) – Waleed Jan 25 '23 at 05:50
  • (Yes .accepted answer as my question formulated) . Please, In addition to my last comment, (as a last hope) I found this helpful link https://www.devhut.net/vba-opening-files-and-urls/ – Waleed Jan 25 '23 at 06:27
  • Added a version using `ShellExecute` (API). Please, test it, too. I would like to see how the hyperlink address looks. I mean, in case of spaces in the path, does it use spaces or `%20`, or `%22` for something else... – FaneDuru Jan 25 '23 at 11:21
  • @Waleed i forgot targeting you in the above comment... – FaneDuru Jan 25 '23 at 13:44
  • All works perfectly now. currently I have not access to my networks resources to check, But I think spaces are truncated automatically when the users upload a file to the server, Anyhow I will feed you back. grateful for your dedicated help – Waleed Jan 25 '23 at 19:14
  • Please, Is (custom right_click menu) support a custom icon entry? – Waleed Feb 07 '23 at 13:09
  • @Waleed I think, yes... But using a different method and being able to create a bmp picture and a bmp mask. If you create a new question asking for that, when I will be home (after some hours), I will try answering it. You said **custom icon**, not existing `FaceId`. Correct? This second way should be simpler... Now I am leaving my office. – FaneDuru Feb 07 '23 at 15:04
  • Ok, I will post a new question tomorrow.I mean by custom icon: any resources in `Shell32.dll` or any standalone picture. – Waleed Feb 07 '23 at 17:51
  • https://stackoverflow.com/questions/75382665/add-an-icon-to-custom-right-click-menu-application-shortcutmenus – Waleed Feb 08 '23 at 07:44