AddIns - Creating menu options

Well, I just realized I posted my FoundRange function as part of an earlier post (maybe my Burst function). That isn't exactly fair to you now is it. So here is what I put in my ThisWorkbook object for any add-in I write (non-office2007) to create menus/submenus. The comments in the code should be enough for you, but if you have any questions about it please post a comment!

Option Explicit
'I use this as a basis for the code in ThisWorkbook of most add-ins that I make
' -MenuCaption is the menu in the worksheet menu bar to add to. Feel free to create
'  your own menu, or use an existing menu (using the & symbol for the alt-key shortcut)
'  For example, to add your new option(s) to the 'Tools' menu, use &Tools
' -MenuOption1 and MenuOption1MacroName are used for the individual menu options
'  For additional options, follow the same guideline as MenuOption1, and make sure to
'  reference your new Const'ants in the Workbook_Open and RemoveMenuOption subroutines
Private Const MenuCaption As String = "&New Menu"
Private Const MenuOption1 As String = "&Menu Option"
Private Const MenuOption1MacroName As String = "MacroName"

Private Sub Workbook_Open()
 Dim CmdBar As Object, NewMenu As Object, NewSubMenu As Object
 
 RemoveMenuOption
 On Error Resume Next
 Set CmdBar = Application.CommandBars("Worksheet Menu Bar")
 Set NewMenu = AddMenu(CmdBar, MenuCaption)

''Use syntax like this for a sub-menu
' Set NewSubMenu = AddMenu(NewMenu, MenuName1)
' AddControl NewSubMenu, MenuOption1_1, MenuOption1_1MacroName
' AddControl NewSubMenu, MenuOption1_2, MenuOption1_2MacroName
 
'Otherwise use this syntax
 AddControl NewMenu, MenuOption1, MenuOption1MacroName
End Sub

Private Function AddMenu(ByRef ParentMenu As Object, ByVal NewMenuName As String) As Object
 Dim vNewMenu As Object
 On Error Resume Next
 Set vNewMenu = ParentMenu.Control(Replace(NewMenuName, "&", ""))
 If vNewMenu Is Nothing Then
  Set vNewMenu = ParentMenu.Controls.Add(Type:=10, Before:=ParentMenu.Controls.Count + 1 _
   , Temporary:=True)   '10=msoControlPopup
  vNewMenu.Caption = NewMenuName
 End If
 Set AddMenu = vNewMenu
End Function

Private Function AddControl(ByRef NewMenu As Object, ByVal vOption As String, _
  ByVal vOptionMacro As String, Optional ByVal vBeginGroup As Boolean = False) As Boolean
 With NewMenu.Controls.Add
  .Caption = vOption
  .BeginGroup = vBeginGroup
  .OnAction = "'" & ThisWorkbook.Name & "'!" & vOptionMacro
  .Tag = Replace(vOption, "&", "")
 End With
End Function

Private Sub Workbook_AddinUninstall()
 RemoveMenuOption
 If Not ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 If Not ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

Private Sub RemoveMenuOption()
 Dim cBc2 As Object, cBc As Object
 On Error Resume Next
 For Each cBc In Application.CommandBars("Worksheet Menu Bar").Controls
  If Replace(cBc.Caption, "&", "") = Replace(MenuCaption, "&", "") Then
   For Each cBc2 In cBc.Controls
    Select Case LCase(Replace(cBc2.Caption, "&", ""))
     Case LCase(Replace(MenuOption1, "&", "")):  cBc2.Delete
     'add more additional Case statements here as you add more MenuOptions
    End Select
   Next
   If cBc.Controls.Count = 0 Then cBc.Delete
   Exit For
  End If
 Next cBc
End Sub