Jeg har fundet denne kode i et gammelt faktura program jeg engang lavede - brug det kan og glem resten. Godt nok er sub'en MyNewMenu udkommenteret, men det var vist den der lavede menu'en on the fly...
Option Explicit
'Menu
'Er grundstenen i menu'erne
'Menu'erne for de enkelte ark bliver lavet oprettet fra de enkelte arks kode
'Der er flere undermakro'er, der bruges til menu dannelse/sletning
'Herefter følger alle de forskellige arks menu-punkt OnAction
Public MenuObject As CommandBarPopup
Public SubMenu As CommandBarPopup
Public MenuItem As Object
Public SubMenuItem As CommandBarButton
Public Const strMenuName As String = "F&aktura"
Public Const strMenuNo As String = 11
Public Const intBarsNo As Integer = 1
Public HideMe As String
Sub MyNewMenu(HideMe As String)
'Values to variables
'strMenuName = "F&aktura"
'strMenuNo = "11"
'intBarsNo = 1
' Make sure the menus aren't duplicated
'DeleteMenu HideMe
'Add MainMenu
'CreateMainMenu strMenuName, strMenuNo, intBarsNo
'Add to MainMenu - ControlPopup and ControlButton
'CreateMenuItem "Item &1", "DummyMacro", "71", False
'CreateSubMenu "&Faktura", True
'CreateSubMenuItem "&Fakturer", "DummyMacro", "85", False
End Sub
Sub CreateMainMenu(strMenuName, strMenuNo As String, intBarsNo As Integer)
'En ny hovedmenu
Set MenuObject = Application.CommandBars(intBarsNo).Controls.Add(Type:=msoControlPopup, _
Before:=strMenuNo, Temporary:=True)
MenuObject.Caption = strMenuName
End Sub
Sub CreateMenuItem(strCaption, strOnAction, strFaceId As String, bolBeginGroup As Boolean)
'Et menupunkt punkt direkte i hovedmenu'en
'MenuItem
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
With MenuItem
.Caption = strCaption
.OnAction = strOnAction
.FaceId = strFaceId
.BeginGroup = bolBeginGroup
End With
End Sub
Sub CreateSubMenu(strCaption As String, bolBeginGroup As Boolean)
'En menugruppe i hovedmenuen
'SubMenu
Set SubMenu = MenuObject.Controls.Add(Type:=msoControlPopup)
With SubMenu
.Caption = strCaption
.BeginGroup = bolBeginGroup
End With
End Sub
Sub CreateSubMenuItem(strCaption, strOnAction, strFaceId As String, bolBeginGroup As Boolean)
'Et menupunkt i en menugruppe
'SubMenu Item - UnderMenuPunkt
Set SubMenuItem = SubMenu.Controls.Add(Type:=msoControlButton)
With SubMenuItem
.Caption = strCaption
.OnAction = strOnAction
.FaceId = strFaceId
.BeginGroup = bolBeginGroup
End With
End Sub
Sub DeleteMenu(HideMe As String)
' This sub should be executed when the workbook is closed
' Deletes the Menus
On Error Resume Next
Application.CommandBars(intBarsNo).Controls(strMenuName).Delete
On Error GoTo 0
End Sub