如何在 Visual Basic 中添加超链接到弹出菜单?

How To Add Hyperlinks To Pop up menu in Visual Basic?

如何让菜单项之一打开超链接?

例如,在菜单中选择按钮 1 时会打开“www.google.com" and Button 2 opens "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

你可以放

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

在你的测试宏中

如果您打算将其用作启动超链接的方法,请向 Testmacro 子过程添加一个参数。

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

实际的 TestMacro sub 会建立一个 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://whosebug.com"
    End Select
End Sub

与 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