Skapa menyalternativ

I detta tips visas hur vi kan skapa menyer och undermenyer till dessa. Mycket av förfarandet känns igen från skapandet av verktygsfält - Se Verktygsfält.


Följande kod placeras i ThisWorkbook / DennaArbetsbok:

Private Sub Workbook_Open()
Call Skapa_Meny
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cbABmeny As CommandBar

On Error Resume Next
'"Arbetsbladmenyn" har indextalet 1, vilket vi använder
'oss här.
Set cbABmeny = Application.CommandBars(1)
cbABmeny.Controls("Meny").Delete
End Sub



Följande kod placeras i en modul:

Sub Skapa_Meny()
Dim cbABmeny As CommandBar
Dim ccEgenMeny As CommandBarControl
Dim iHjalp As Integer

Set cbABmeny = Application.CommandBars(1)

'Här säkerhetsställer vi att inget menyalternativ med
'namnet existerar.
On Error Resume Next
cbABmeny.Controls("Meny").Delete
On Error GoTo 0

'Här identifieras hjälpmenyns indextal
iHjalp = cbABmeny.Controls("Hjälp").Index

'Vi skapar menyalternativet och placerar
'menyn före Hjälp.
Set ccEgenMeny = _
cbABmeny.Controls.Add(Type:=msoControlPopup, _
Before:=iHjalp)

'Slutligen byggs menyn upp
With ccEgenMeny
          .Caption = "&Meny"
          With .Controls.Add(Type:=msoControlButton)
                 .Caption = "Text"
                 .OnAction = "Procedurnamn som ska köras"
                 .FaceId = 343
          End With

          With .Controls.Add(Type:=msoControlPopup)
                 .Caption = "Bladsortering"
              With .Controls.Add(Type:=msoControlButton)
                     .Caption = "Sortera Stigande"
                     .FaceId = 210
                     .OnAction = "Sortera_Stigande"
              End With
              With .Controls.Add(Type:=msoControlButton)
                     .Caption = "Sortera Fallande"
                     .FaceId = 211
                     .OnAction = "Sortera_Fallande"
               End With
           End With

           With .Controls.Add(msoControlDropdown)
                  .AddItem "AA"
                  .AddItem "BB"
                  .OnAction = "Procedurnamn som ska köras"
           End With
End With
End Sub

Så här ser resultatet ut: