Yep, you've got to use an addin, cos it's the only way to get to the VB Extensibility model.
Declare a menu event handler:
Code:
Public WithEvents mnuAddSource As VBIDE.CommandBarEvents
Public WithEvents mnuAddSourceToolbar As VBIDE.CommandBarEvents
Then add the code to create the bar:
Code:
Sub CreateMenuItems()
Dim PopUpMenu As CommandBarPopup
Dim NewMenu As CommandBar
Dim MyItem As CommandBarButton
Set NewMenu = VBInstance.CommandBars("Tools")
Set PopUpMenu = NewMenu.Controls.Add(msoControlPopup)
PopUpMenu.Caption = "Source &Library"
PopUpMenu.Tag = "Source Library"
Set MyItem = PopUpMenu.CommandBar.Controls.Add(msoControlButton)
MyItem.Caption = "&Add New Source Code"
Set mnuAddSource = VBInstance.Events.CommandBarEvents(MyItem)
Clipboard.SetData LoadResPicture("ADDSOURCECODE", vbResBitmap)
MyItem.PasteFace
Set mnuAddSourceToolbar = VBInstance.Events.CommandBarEvents(CreateCommandBar("Add Source Code", "Add Source Code", LoadResPicture("ADDSOURCECODE", vbResBitmap)))
End Sub
This will add a menu item called "Source Library" On the "Tools" menu, and put a button on the toolbar that is created using the function below (CreateCommandBar)
Code:
Function CreateCommandBar(pstrCaption As String, pstrTooltip As String, pobjPicture As StdPicture) As Office.CommandBarControl
Dim cbMenuCommandBar As Office.CommandBarButton 'command bar object
Dim cbMenu As CommandBar
Dim llngTop As Long
Dim llngLeft As Long
Dim llngPosition As Office.MsoBarPosition
Dim llngRowIndex As Long
On Error GoTo AddToAddInCommandBarErr
If cbMenu Is Nothing Then
Set cbMenu = VBInstance.CommandBars.Add("MyCommandBar", , , False)
End If
cbMenu.Visible = True
If Not cbMenu Is Nothing Then
'add it to the command bar
Set cbMenuCommandBar = cbMenu.Controls.Add(msoControlButton)
'set the caption
cbMenuCommandBar.Caption = pstrCaption
cbMenuCommandBar.Visible = True
cbMenuCommandBar.Enabled = True
cbMenuCommandBar.ToolTipText = pstrTooltip
Clipboard.SetData pobjPicture
cbMenuCommandBar.PasteFace
Set CreateCommandBar = cbMenuCommandBar
Set cbMenu = Nothing
End If
AddToAddInCommandBarErr:
If Err.Number <> 0 Then
MsgBox "Unknown error occured while trying to add to the toolbar!" & vbCrLf & vbCrLf & "Error was: " & Err.Number & " - " & Err.Description, vbExclamation, "Error in Add-In"
Err.Clear
'Resume
End If
End Function
Also need some code to destroy the menus and commandbars you have created:
Code:
Sub DestroyMenuItems()
'delete the menu items and clear the menu handler objects
Dim MenuItem As CommandBarControl
'$$$ START OF MENUITEM DELETION
On Error Resume Next
DeleteCommandBarControl "Tools", "Source &Library"
DeleteCommandBarControl "MyCommandBar", "ButtonName"
If VBInstance.CommandBars("MyCommandBar").Controls.Count = 0 Then
VBInstance.CommandBars("MyCommandBar").Visible = False
End If
End Sub
Private Sub DeleteCommandBarControl(pstrCommandBar As String, pstrName As String)
Dim lobjControl As CommandBarControl
While CommandBarControlExists(pstrCommandBar, pstrName)
For Each lobjControl In VBInstance.CommandBars(pstrCommandBar).Controls
If lobjControl.Caption = pstrName Then
VBInstance.CommandBars(pstrCommandBar).Controls(lobjControl.Index).Delete
Exit For
End If
Next lobjControl
Wend
End Sub
Private Function CommandBarControlExists(pstrCommandBar As String, pstrName As String) As Boolean
Dim lobjControl As CommandBarControl
CommandBarControlExists = False
For Each lobjControl In VBInstance.CommandBars(pstrCommandBar).Controls
If lobjControl.Caption = pstrName Then
CommandBarControlExists = True
Exit For
End If
Next lobjControl
Set lobjControl = Nothing
End Function
Call the CreateMenuItems on the Startup event of the addin, and the DestroyMenuItems in the OnDisconnection event.
My apologies fro any dodgy code - I ripped it from a relatively complex toolbar addin routine that supports multiple addins using the smae tool bar, and multiple menu hierarchies, so it is a bit messy
- gaffa
Reply With Quote