Excel Forum

Code: Select all

Private Sub Workbook_Open()
 'On Error Resume Next
    Call COGNOSoolbar
    Call COGNOSButton
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  '  On Error Resume Next
    Application.CommandBars("Analyst_Toolbar").Delete
End Sub

Code: Select all

Sub WBCreatePopUp()
'   NOTE: There is no error handling in this subroutine

    Dim MenuSheet As Worksheet
    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim Row As Integer
    Dim MenuLevel, NextLevel, MacroName, Caption, Divider, FaceId

    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    '   Location for menu data
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    ''''''''''''''''''''''''''''''''''''''''''''''''''''

    '   Make sure the menus aren't duplicated
    Call WBRemovePopUp

    '   Initialize the row counter
    Row = 5

    '   Add the menu, menu items and submenu items using
    '   data stored on MenuSheet

    ' First we create a PopUp menu with the name of the value in B2
    With Application.CommandBars.Add(ThisWorkbook.Sheets("MenuSheet"). _
                                     Range("B2").Value, msoBarPopup, False, True)

        Do Until IsEmpty(MenuSheet.Cells(Row, 1))
            With MenuSheet
                MenuLevel = .Cells(Row, 1)
                Caption = .Cells(Row, 2)
                MacroName = .Cells(Row, 3)
                Divider = .Cells(Row, 4)
                FaceId = .Cells(Row, 5)
                NextLevel = .Cells(Row + 1, 1)
            End With

            Select Case MenuLevel
            Case 2    ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = .Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = .Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                End If
                MenuItem.Caption = Caption
                If FaceId <> "" Then MenuItem.FaceId = FaceId
                If Divider Then MenuItem.BeginGroup = True

            Case 3    ' A SubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                If FaceId <> "" Then SubMenuItem.FaceId = FaceId
                If Divider Then SubMenuItem.BeginGroup = True
            End Select
            Row = Row + 1
        Loop
    End With
End Sub

Code: Select all

Sub WBCreatePopUp()
'   NOTE: There is no error handling in this subroutine

    Dim MenuSheet As Worksheet
    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim MenuItem2 As Object
    Dim SubMenuItem2 As CommandBarButton
    Dim Row As Integer
    Dim MenuLevel, NextLevel, MacroName, Caption, Divider, FaceId

    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    '   Location for menu data
    Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
    ''''''''''''''''''''''''''''''''''''''''''''''''''''

    '   Make sure the menus aren't duplicated
    Call WBRemovePopUp

    '   Initialize the row counter
    Row = 5

    '   Add the menu, menu items and submenu items using
    '   data stored on MenuSheet

    ' First we create a PopUp menu with the name of the value in B2
    With Application.CommandBars.Add(ThisWorkbook.Sheets("MenuSheet"). _
                                     Range("B2").Value, msoBarPopup, False, True)

        Do Until IsEmpty(MenuSheet.Cells(Row, 1))
            With MenuSheet
                MenuLevel = .Cells(Row, 1)
                Caption = .Cells(Row, 2)
                MacroName = .Cells(Row, 3)
                Divider = .Cells(Row, 4)
                FaceId = .Cells(Row, 5)
                NextLevel = .Cells(Row + 1, 1)
            End With
            Select Case MenuLevel
            Case 2    ' A Menu Item
                If NextLevel = 3 Then
                    Set MenuItem = .Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem = .Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                End If
                MenuItem.Caption = Caption
                If FaceId <> "" Then MenuItem.FaceId = FaceId
                If Divider Then MenuItem.BeginGroup = True

            Case 3   ' A SubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                If FaceId <> "" Then SubMenuItem.FaceId = FaceId
                If Divider Then SubMenuItem.BeginGroup = True
            
            Case 4    ' A Menu2 Item
                If NextLevel = 5 Then
                    Set MenuItem2 = MenuItem.Controls.Add(Type:=msoControlPopup)
                Else
                    Set MenuItem2 = MenuItem.Controls.Add(Type:=msoControlButton)
                    MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
                End If
                MenuItem2.Caption = Caption
                If FaceId <> "" Then MenuItem2.FaceId = FaceId
                If Divider Then MenuItem2.BeginGroup = True
            Case 5   ' A SubMenu2 Item
                Set SubMenuItem2 = MenuItem2.Controls.Add(Type:=msoControlButton)
                SubMenuItem2.Caption = Caption
                SubMenuItem2.OnAction = ThisWorkbook.Name & "!" & MacroName
                If FaceId <> "" Then SubMenuItem2.FaceId = FaceId
                If Divider Then SubMenuItem2.BeginGroup = True
            End Select
            Row = Row + 1
        Loop
    End With
End Sub