none
How To Add Hyperlinks To Pop up menu Visual Baisc? RRS feed

  • Question

  • How do I make one of the menu items open a hyperlink?

    For example say Button 1 when selected in the menu opens "www.google.com" and Button 2 opens "www.yahoo.com" instead of test Macro. I tried changing the .OnAction to .FollowHyperlink. I even tried just entering the hyperlink in the .OnAction section with no luck.

    Any advice?

    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

    Wednesday, September 30, 2015 8:48 PM

Answers

  • A simple example of code to run after a button is clicked.

    Note that when the code is copied into this post that the URL becomes a hyperlink. When the code is copied into the VBA editor it will be simply text as it should be.

    Afterthought: The sub should be called with the OnAction command

    Sub FollowHyperLink()
        Dim strAddress As String
        strAddress = "https://www.google.com.au/advanced_search"
            On Error GoTo Problem
            ActiveWorkbook.FollowHyperLink Address:=strAddress, NewWindow:=True
            Exit Sub
    Problem:
            MsgBox "Cannot open " & strAddress
    End Sub


    Regards, OssieMac


    • Edited by OssieMac Thursday, October 1, 2015 1:40 AM
    • Marked as answer by Richard Dixon Thursday, October 1, 2015 6:48 PM
    Thursday, October 1, 2015 1:33 AM

All replies

  • A simple example of code to run after a button is clicked.

    Note that when the code is copied into this post that the URL becomes a hyperlink. When the code is copied into the VBA editor it will be simply text as it should be.

    Afterthought: The sub should be called with the OnAction command

    Sub FollowHyperLink()
        Dim strAddress As String
        strAddress = "https://www.google.com.au/advanced_search"
            On Error GoTo Problem
            ActiveWorkbook.FollowHyperLink Address:=strAddress, NewWindow:=True
            Exit Sub
    Problem:
            MsgBox "Cannot open " & strAddress
    End Sub


    Regards, OssieMac


    • Edited by OssieMac Thursday, October 1, 2015 1:40 AM
    • Marked as answer by Richard Dixon Thursday, October 1, 2015 6:48 PM
    Thursday, October 1, 2015 1:33 AM
  • Thanks ^_^

    Awesome.

    Thursday, October 1, 2015 6:49 PM