Option Explicit

Sub MakeMenu()

'''''''''''''''''''''''''''''''''''''''''''''
'Erstatter Excels standardmenu med en
'brugerdefineret menu.
'''''''''''''''''''''''''''''''''''''''''''''

Dim cbMyBar As CommandBar
Dim cbcMain As CommandBarControl
Dim cbcSub As CommandBarControl

On Error GoTo ErrorHandle

'''''''''''''''''''''''''''''''''''''''''''''
'Menubjælken cbMyBar indsættes i
'stedet for standardmenuen.
'''''''''''''''''''''''''''''''''''''''''''''

Set cbMyBar = CommandBars.Add(Name:="Custom", _
Position:=msoBarTop, MenuBar:=True, Temporary:=True)

With cbMyBar
    .Visible = True
    .Protection = msoBarNoMove
End With

'''''''''''''''''''''''''''''''''''''''''''''
'Nu tilføjes menupunkterne.
'Først en barberet "standard" Fil-menu
'''''''''''''''''''''''''''''''''''''''''''''

Set cbcMain = cbMyBar.Controls. _
Add(msoControlPopup, Temporary:=True)

With cbcMain
    .Caption = "&Filer"
    .Tag = "Filer"
    'TooltipText er den tekst som vises, når
    'musen svæver over menuen.
    .TooltipText = "Åbn, Gem, Udskriv og Afslut"
End With
    
'''''''''''''''''''''''''''''''''''''''''''''
'Nu tilføjes underpunkter til Fil-menuen.
'OnAction fortæller, hvilken makro der skal
'køre, hvis menupunktet vælges.
'FaceId = 23 indsætter det lille fil-åben
'ikon foran menupunktet.
'''''''''''''''''''''''''''''''''''''''''''''

With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Åbn..."
    .OnAction = "FilOp"
    .Style = msoButtonIconAndCaption
    .FaceId = 23
    .Visible = True
End With

'Næste underpunkt tilføjes: Luk-kommandoen.
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Luk"
    .OnAction = "Luk"
    .Style = msoButtonAutomatic
    .Visible = True
End With

'Gem-menuen får en linie over sig med
'.BeginGroup = True
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Gem"
    .OnAction = "Gem"
    .Style = msoButtonIconAndCaption
    .FaceId = 3
    .Visible = True
    .BeginGroup = True
End With

'Gem-som menuen
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Gem som..."
    .OnAction = "GemSom"
    .Style = msoButtonIconAndCaption
    .FaceId = 3
    .Visible = True
End With
    
'Udskriftsdialog
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Udskriv..."
    .OnAction = "Udskriv"
    .Style = msoButtonIconAndCaption
    .FaceId = 4
    .Visible = True
End With

'Og endelig Afslut for at lukke Excel
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Afslut"
    .OnAction = "Afslut"
    .Style = msoButtonAutomatic
    .Visible = True
    .BeginGroup = True
End With
    
''''''''''''''''''''''''''''''''''''''''''''''
'Nu tilføjes en menu til højre for Fil-menuen.
''''''''''''''''''''''''''''''''''''''''''''''

Set cbcMain = cbMyBar.Controls. _
Add(Type:=msoControlPopup, Temporary:=True)

With cbcMain
    .Caption = "&MinMenu1"
    .TooltipText = "Gør dit og dat"
End With
    
'Underpunkt2.1
Set cbcSub = cbcMain.Controls. _
Add(Type:=msoControlPopup, Temporary:=True)
With cbcSub
    .Caption = "&Dippedutter m.m..."
End With

'Laver en undermenu til underpunkt 2.1
With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "D&ippeduttter..."
    .OnAction = "DummyMacro1"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
End With

'Laver endnu en undermenu til underpunkt 2.1
With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "D&uppeditter..."
    .OnAction = "DummyMacro2"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
    .Enabled = True
End With

'Laver endnu en undermenu til underpunkt 2.1
With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "Du&ttedipper..."
    .OnAction = "DummyMacro3"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
End With

'Laver endnu en undermenu til underpunkt 2.1
With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "D&appedytter..."
    .OnAction = "DummyMacro1"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
End With

'Underpunkt 2.2 til MinMenu1
Set cbcSub = cbcMain.Controls. _
Add(Type:=msoControlPopup, Temporary:=True)

With cbcSub
    .Caption = "&Varelager..."
End With

'Undermenuer til underpunkt 2.2
With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Hyldevarer..."
    .OnAction = "DummyMacro1"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
End With

With cbcSub.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Metervarer..."
    .OnAction = "DummyMacro1"
    .Style = msoButtonIconAndCaption
    .FaceId = 136
    .Enabled = True
End With

'Underpunkt 2.3 til MinMenu1
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Kalorieberegning"
    .OnAction = "DummyMacro1"
    .Style = msoButtonIconAndCaption
    .FaceId = 133
    .Visible = True
End With

'Underpunkt 2.4 til MinMenu1
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Beregning af overtræk"
    .OnAction = "DummyMacro2"
    .Style = msoButtonIconAndCaption
    .FaceId = 133
    .Visible = True
End With

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Det næste menupunkt tilføjes til
'højre for MinMenu1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set cbcMain = cbMyBar.Controls.Add _
(msoControlPopup, 1, , , True)

With cbcMain
    .Caption = "M&inMenu2"
    .Tag = "MinMenu2"
    .TooltipText = "Helte && skurke"
End With

'Underpunkt 3.1 tilføjes
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Helte"
    .OnAction = "DummyMacro2"
    .Style = msoButtonIconAndCaption
    .FaceId = 990
End With

'Underpunkt 3.2 tilføjes
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Skurke"
    .OnAction = "DummyMacro2"
    .Style = msoButtonIconAndCaption
    .FaceId = 990
End With

'Underpunkt 3.3 tilføjes
With cbcMain.Controls. _
Add(Type:=msoControlButton, Temporary:=True)
    .Caption = "&Gem helt"
    .OnAction = "DummyMacro2"
    .Style = msoButtonIconAndCaption
    .FaceId = 3
End With

BeforeExit:
Set cbcMain = Nothing
Set cbcSub = Nothing
Set cbMyBar = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i MakeMenu", _
vbCritical + vbOKOnly, "Fejl"
Resume BeforeExit
End Sub

Sub RemoveMenu()

'''''''''''''''''''''''''''''''''''''
'Fjerner alle ikke-indbyggede menu-
'og værktøjslinier og genskaber
'Excels standardmenu.
'''''''''''''''''''''''''''''''''''''

Dim cbBar As CommandBar

On Error GoTo ErrorHandle

For Each cbBar In Application.CommandBars
    If Not cbBar.BuiltIn Then cbBar.Delete
Next

Exit Sub
ErrorHandle:
MsgBox Err.Description & " RemoveMenu", vbOKOnly, "Fejl"
End Sub

''''''''''''''''''''''''''''''''''''''''
'Her følger de makroer, som køres af de
'forskellige menupunkter.
''''''''''''''''''''''''''''''''''''''''

Sub FilOp()
    Application.Dialogs(xlDialogOpen).Show
End Sub
Sub Luk()
    ActiveWorkbook.Close
End Sub
Sub Gem()
    ActiveWorkbook.Save
End Sub
Sub GemSom()
    Application.Dialogs(xlDialogSaveAs).Show
End Sub
Sub Udskriv()
    Application.Dialogs(xlDialogPrint).Show
End Sub
Sub Afslut()
    Application.Quit
End Sub
Sub DummyMacro1()
    MsgBox "Skriv din egen makro i stedet for denne besked.", _
    vbOKOnly, "Hej-hej"
End Sub
Sub DummyMacro2()
    MsgBox "Skriv noget kode i VBA.", _
    vbOKOnly, "Hallo De dér!"
End Sub
Sub DummyMacro3()
    MsgBox "Og med min pil og bue jeg skød en albatros.", _
    vbOKOnly, "Anders And"
End Sub

''''''''''''''''''''''''''''''''''''''''
'De næste 2 makroer skal indsættes i
'makrodelen for "ThisWorkbook".
''''''''''''''''''''''''''''''''''''''''

Private Sub Workbook_Activate()
MakeMenu
End Sub
Private Sub Workbook_Deactivate()
RemoveMenu
End Sub