bjacobowski
02-04-2010, 10:21 PM
I am attempting to create a custom menu for an add-in. In addition to several standard menu items that call macros, userforms, etc., I would also like to have menu items that open other excel workbooks (templates that are needed for the add-in). When you try to record a macro that adds a hyperlink to a menu item (through the customize menu dialog box) it only captures the creation of the button and not the hyperlink.
Here is the code I've got:
Sub Create_MStemplate_Menu()
'Create a menu with links to all excel files in specified directory
Dim lCount As Long
Dim file_Path As String
Dim MenuItem As Object
Dim MenuObject As CommandBarPopup
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Specify folder containing the files you need links to
file_Path = "U:\Common\PENSION\MORNINGSTAR\Excel Add-In Templates"
Set MenuObject = Application.CommandBars(1).Controls _
.Add(Type:=msoControlPopup, temporary:=True)
MenuObject.Caption = ("Mornin&gstar Template")
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = file_Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
'------------------------------------------------------------
'The following line opens all the files in the directory as opposed to
'creating a hyperlink. I have also tried the following method to no avail:
'menuItem.hyperlinktype = msoCommandBarButtonHyperlinkOpen
'menuItem.TooltipText = "some file"
MenuItem.OnAction = Workbooks.Open(.FoundFiles(lCount))
MenuItem.Caption = _
Replace(Replace(.FoundFiles(lCount), file_Path & "\", ""), ".xlt", "")
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Sub deleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mornin&gstar Template").Delete
End Sub
Thanks in advance for any help!
Here is the code I've got:
Sub Create_MStemplate_Menu()
'Create a menu with links to all excel files in specified directory
Dim lCount As Long
Dim file_Path As String
Dim MenuItem As Object
Dim MenuObject As CommandBarPopup
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Specify folder containing the files you need links to
file_Path = "U:\Common\PENSION\MORNINGSTAR\Excel Add-In Templates"
Set MenuObject = Application.CommandBars(1).Controls _
.Add(Type:=msoControlPopup, temporary:=True)
MenuObject.Caption = ("Mornin&gstar Template")
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = file_Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
'------------------------------------------------------------
'The following line opens all the files in the directory as opposed to
'creating a hyperlink. I have also tried the following method to no avail:
'menuItem.hyperlinktype = msoCommandBarButtonHyperlinkOpen
'menuItem.TooltipText = "some file"
MenuItem.OnAction = Workbooks.Open(.FoundFiles(lCount))
MenuItem.Caption = _
Replace(Replace(.FoundFiles(lCount), file_Path & "\", ""), ".xlt", "")
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Sub deleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mornin&gstar Template").Delete
End Sub
Thanks in advance for any help!