Как добавить гиперссылки на всплывающее меню в Visual Basic?

Question

Как сделать один из пунктов меню открытием гиперссылки?

Например, кнопка 1, когда в меню открывается «www.google.com», и кнопка 2 открывается «www.yahoo.com» вместо тестового макроса. Я попытался изменить .OnAction на .FollowHyperlink.

Я даже попробовал просто ввести гиперссылку в разделе .OnAction без везения.

Любые советы?

Option Explicit 

Public Const Mname As String = "MyPopUpMenu" 

Sub DeletePopUpMenu() 
    ' Delete the popup menu if it already exists. 
    On Error Resume Next 
    Application.CommandBars(Mname).Delete 
    On Error GoTo 0 
End Sub 

Sub CreateDisplayPopUpMenu() 
    ' Delete any existing popup menu. 
    Call DeletePopUpMenu 

    ' Create the popup menu. 
    Call Custom_PopUpMenu_1 

    ' Display the popup menu. 
    On Error Resume Next 
    Application.CommandBars(Mname).ShowPopup 
    On Error GoTo 0 
End Sub 

Sub Custom_PopUpMenu_1() 
    Dim MenuItem As CommandBarPopup 
    ' Add the popup menu. 
    With Application.CommandBars.Add(Name:=Mname, Position:=msoBarPopup, _ 
     MenuBar:=False, Temporary:=True) 

     ' First, add two buttons to the menu. 
     With .Controls.Add(Type:=msoControlButton) 
      .Caption = "Button 1" 
      .FaceId = 71 
      .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro" 
     End With 

     With .Controls.Add(Type:=msoControlButton) 
      .Caption = "Button 2" 
      .FaceId = 72 
      .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro" 
     End With 

     ' Next, add a menu that contains two buttons. 
     Set MenuItem = .Controls.Add(Type:=msoControlPopup) 
     With MenuItem 
      .Caption = "My Special Menu" 

      With .Controls.Add(Type:=msoControlButton) 
       .Caption = "Button 1 in menu" 
       .FaceId = 71 
       .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro" 
      End With 

      With .Controls.Add(Type:=msoControlButton) 
       .Caption = "Button 2 in menu" 
       .FaceId = 72 
       .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro" 
      End With 
     End With 

     ' Finally, add a single button. 
     With .Controls.Add(Type:=msoControlButton) 
      .Caption = "Button 3" 
      .FaceId = 73 
      .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro" 
     End With 

    End With 
End Sub 

Sub TestMacro() 
    MsgBox "Hi there!" 
End Sub 

Answer 1

Вы можете поставить

ThisWorkbook.FollowHyperlink "http://......" 

В вашем TestMacro

Answer 2

Если вы собираетесь использовать это в качестве способа запуска гиперссылок, добавьте параметр в процедуре Testmacro к югу.

.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(1)" 
... 
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(2)" 
... 
.OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(3)" 

TestMacro Фактический суб будет возбуждать Select Case statement обрабатывать все команды меню.

Sub TestMacro(Optional iTYP As Long = 1) 
    Select Case iTYP 
     Case 1 
      MsgBox "option 1" 
      ActiveWorkbook.FollowHyperlink "http://www.google.com" 
     Case 2 
      MsgBox "option 2" 
      ActiveWorkbook.FollowHyperlink "http://www.yahoo.com" 
     Case 3 
      MsgBox "option 3" 
      ActiveWorkbook.FollowHyperlink "http://www.bing.com" 
     Case Else 
      ActiveWorkbook.FollowHyperlink "http://stackoverflow.com" 
    End Select 
End Sub 

Answer 3

, как с Bas ответ вы можете установить TestMacro иметь входную строку для URL, а затем передать, что при вызове его

' Finally, add a single button. 
    With .Controls.Add(Type:=msoControlButton) 
     .Caption = "Button 3" 
     .FaceId = 73 
     .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro(" & Chr(34) & "http://www.google.com" & Chr(34) & ")" 
    End With 



Sub TestMacro(url As String) 
    ThisWorkbook.FollowHyperlink url 
End Sub