Excel VBA

Custom Menu

The toolkit is constantly evolving and growing. I actually added 2 tools today and fixed a few little bugs.

Option Explicit

Private Sub Workbook_AddInInstall()
'Adds procdures to the Utils Menu
'Alan Barasch ~~ 04/26/2005 ~~ 314-XXX-XXXX

    Dim objCmdBrPp As CommandBarPopup
    Dim objCmdBtn As CommandBarButton
    Dim myCustom As CommandBarControl
    Dim cbcMenuBar As CommandBar
    Dim iHelpIndex As Integer

    Set cbcMenuBar = Application.CommandBars("Worksheet Menu Bar")
    iHelpIndex = cbcMenuBar.Controls("Help").Index

    Set myCustom = cbcMenuBar.Controls. _
                   Add(Type:=msoControlPopup, before:=iHelpIndex)

    With myCustom
        .Caption = "&RGB"
        
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Shor&ten UPC Width"
            .OnAction = "FixUPCLength"  'Chg 11 or 12 digit UPC to standard 10
            .FaceId = 9678
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Pad UPC to 10 digits"   'Caption on Menu
            .OnAction = "Text2NumericUPC"       'Macro to call
            .FaceId = 3096                      'Icon on menu
            'Padded to 10 places
        End With
                With .Controls.Add(Type:=msoControlButton)
            .Caption = "B&reak Sheet by Stores" 'Caption on Menu
            .OnAction = "BreakStoresIntoTabs"  'Macro to call
            .BeginGroup = True                  'Separtor line above
            .FaceId = 2556                      'Menu Icon
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "T&wist Stores from Top"
            .OnAction = "TwistAndShout"     'Melissa's stores
            .FaceId = 9143
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Combine Ta&bs into One Sheet"  'The ampersand (&) makes a hot letter
            .OnAction = "CombineIntoOne"
            .FaceId = 1548
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Insert Date in Cell"
            .OnAction = "PopUpCalendar"
            .FaceId = 1106
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Help"
            .OnAction = "GetVersionInfo"
            .FaceId = 1089
            .BeginGroup = True
        End With
    End With

End Sub

Private Sub Workbook_AddinUninstall()
' This procedure deletes an item on the Tools
' menu on the worksheet menu bar.

' If the Project command exists, delete it.
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar") _
            .Controls("&RGB").Delete
End Sub