Egendefinerte menyer i Excel97 og senere versjoner

I Excel97 eller senere kan menyer og verktøylinjeknapper også manipuleres med CommandBar-objektet. Her er noen eksempelmakroer som kan benyttes til å lage egendefinerte menyer:

Sub CreateMenu()
' lager en ny meny
' kan også benyttes til å lage verktøylinjeknapper
' kan eventuelt utføres automatisk fra en Auto_Open-makro eller 
' en Workbook_Open hendelsesmakro
Dim cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
    RemoveMenu ' slett menyen dersom den allerede eksisterer
    ' lag en ny meny på en eksisterende CommandBar (de neste 6 linjene)
    Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&My menu"
        .Tag = "MyTag"
        .BeginGroup = False
    End With
    ' eller legg til i en eksisterende meny 
    ' (bruk den neste linjen i stedet for de 6 forrige linjene)
    'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Verktøy-menyen
    If cbMenu Is Nothing Then Exit Sub ' fant ikke menyen...


    ' legg til et menyvalg i menyen
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Menyvalg1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
    End With
    ' legg til et menyvalg i menyen
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Menyvalg2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
    End With


    ' legg til en undermeny
    Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Undermeny1"
        .Tag = "SubMenu1"
        .BeginGroup = True
    End With
    ' legg til et menyvalg i undermenyen (eller knapper på en CommandBar)
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Undermenyvalg1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 71
        .State = msoButtonDown ' eller msoButtonUp
    End With


    ' legg til et menyvalg i undermenyen (eller knapper på en CommandBar)
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Undermenyvalg2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 72
        .Enabled = False ' eller True
    End With


    ' legg til en undermeny i undermenyen
    Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Undermeny2"
        .Tag = "SubMenu2"
        .BeginGroup = True
    End With
    ' legg til et menyvalg i undermenyen i undermenyen
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Undermanyvalg1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 71
        .State = msoButtonDown ' eller msoButtonUp
    End With
    ' legg til et menyvalg i undermenyen i undermenyen
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Undermanyvalg2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 72
        .Enabled = False ' eller True
    End With


    ' legg til et menyvalg i menyen
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Fjern denne menyen"
        .OnAction = ThisWorkbook.Name & "!RemoveMenu"
        .Style = msoButtonIconAndCaption
        .FaceId = 463
        .BeginGroup = True
    End With
    Set cbSubMenu = Nothing
    Set cbMenu = Nothing
End Sub

Sub RemoveMenu()
' kan eventuelt utføres automatisk fra en Auto_Close-makro eller 
' en Workbook_BeforeClose hendelsesmakro
    DeleteCustomCommandBarControl "MyTag" ' sletter den nye menyen
End Sub

Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' sletter ALLE forekomster av CommandBar-kontroller med en Tag = CustomControlTag
    On Error Resume Next
    Do
        Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
    Loop Until _
        Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
    On Error GoTo 0
End Sub

Sub Macroname()
' brukes av menyvalgene som opprettes av makroen CreateMenu
    MsgBox "Dette kunne vært din makro som ble startet!", _
        vbInformation, ThisWorkbook.Name
End Sub

CommandBar Tools er et nyttig verktøy som kan hjelpe deg med å finne navn og ID-nummer til de forskjellige CommandBar-ene og deres knapper og menyer.

Dokumentet er sist oppdatert 2000-02-05 22:10:37 Utskriftsvennlig versjon