添加自定义Right_click菜单，使用VBA或API方法打开超链接(. doc .pdf . xls . jpg .

Question

关于这个问题链接
所以，而不是点击超链接的正常方式，我需要以下内容:
1-添加一个自定义的right_click菜单，使用VBA方法打开超链接。
2-讨论中的文档都是(. doc .pdf . xls . jpg . zip扩展名文件)，以避免点击超链接产生任何警告消息。
3-如果可能的话，自定义菜单只在右键单击特定列时显示。
4-如果可能的话，打开文档的命令出现在主右键菜单上(而不是作为子菜单)。
5-使用右键打开多个超链接(当然，每个单元格将包含一个超链接)

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

Answer 1

请尝试使用下一个解决方案:

1. 复制ThisWorkbook代码模块中的下一个事件代码。如果您已经使用了Open事件，请在其中包含下面的代码行。它将在格式单元格上下文菜单中打开一个控件("打开文档"):

Private Sub Workbook_Open()
Application.ShortcutMenus(xlWorksheetCell).MenuItems.Add "Open document", "OpenDocument", , 1, , ""
End Sub

还要注意从上下文菜单中删除该选项:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ShortcutMenus(xlWorksheetCell).MenuItems("Open document").Delete
End Sub

2. 在标准模块中复制被调用的Sub代码:

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

:

这是一个使用ShellExecute的新版本，它(可能)将能够在默认应用程序中打开文档:

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

必要的API声明(要放在上面存在Sub的模块的顶部):

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

以上声明适用于64位安装。它也可以很容易地适应为32位工作，但让我们看看它做你需要的…