Nyt menupunkt, med underpunkter

Vis->Værktøjslinier->Tilpas, fanen Kommandoer
Under "Kategorier:" til venstre vælges: Ny menu
Fra "Kommandoer:" til højre trækkes: "Ny menu" op på den ønskede placering i menulinien
Højreklik på menupunktet, og vælg punktet "Navn" for at skrive navnet på menupunktet


På tilsvarende måde kan der tilføjes undermenuer til menuen.

Menupunkter tilføjes på samme måde, vced at trække dem fra dialogboksen, og op på den ønskede placering i menuen.

Enten via VBA - så du evt. kun har menupunktet i én bestemt fil

eller standard, så den i person.xls

VBA er selvfølgelig lidt tungere...

Standard er således:

Funktioner->Tilpas->Kommandoer->Ny Menu
og sæt den ind

Dernæst

Funktioner->Tilpas->Kommandoer->Makroer->Brugerdefineret menupunkt

indsæt den og tilknyt din makro!

tak'r, hvordan gør man det via vba ?
alj

I ThisWorkbook - skrives alt det nedenstående:

Option Explicit


Dim NewMenuItem As CommandBarControl

Const MenuCaption = "NyMenu"
Const UnderMenuCaption = "NyUndermenu"

Public Sub NyMenu()
    Dim ctrl1 As CommandBarButton
    Dim mnuNyUndermenuLocal As CommandBarButton
    Dim MenuItem As CommandBarControl
    Dim LocalMenuItem As CommandBarControl
    Dim MenuBar As CommandBar
    Dim strPreKode As String

    Set MenuBar = Application.CommandBars.ActiveMenuBar
    bMenuExists = False

    MenuBar.Reset
   
    For Each MenuItem In MenuBar.Controls
        If MenuItem.Caption = MenuCaption Then
            bMenuExists = True
            Set LocalMenuItem = MenuItem
            Set mnuNyUndermenuLocal = MenuItem.CommandBar.Controls(NyUndermenuCaption)
        End If
    Next MenuItem
   
    If Not bMenuExists Then
        Set LocalMenuItem = MenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        LocalMenuItem.Move Before:=10
        LocalMenuItem.Caption = MenuCaption
        Set ctrl1 = LocalMenuItem.CommandBar.Controls.Add(Type:=msoControlButton, ID:=1, Temporary:=True)
        With ctrl1
          .Caption = ODBCCaption
          .Style = msoButtonCaption
          .OnAction = "Navnet på din makro"
        End With
    Set NewMenuItem = LocalMenuItem
       
        If CheckTemplate Then
        NewMenuItem.Enabled = False
    End If
       
End If
   
End Sub

Public Sub SletMenu()
    If Not NewMenuItem Is Nothing Then
        On Error Resume Next
        NewMenuItem.Delete
        On Error GoTo 0
        Set NewMenuItem = Nothing
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    SletMenu
End Sub

Private Sub Workbook_Activate()
    NyMenu
End Sub

Private Sub Workbook_Deactivate()
    SletMenu
End Sub

Private Sub Workbook_Open()
    NyMenu
End Sub

Private Function CheckTemplate() As Boolean
    Dim bResult As Boolean
    bResult = False
    If UCase(Application.ActiveWorkbook.Name) = "TEMPLATE.XLS" Then
        bResult = True
    End If
    CheckTemplate = bResult
End Function

Public Sub TrigMenu(shtWorkSheet As Worksheet)
    Workbook_SheetActivate shtWorkSheet
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    NyMenu
End Sub

Ovenstående skulle gerne give en ny menu - med undermenu! Der kan være fejl - er skrevet rimelig hurtigt....

dejligt, så kan jeg vist komme videre.
Tak'r
Alan

hvis det virker!

Det gør den selvfølgelig - har ikke lige tid til at se hvad jeg har skrevet forket - men det kommer!!!

Ja, du skal bruge denne istedet for:

Option Explicit


Dim NewMenuItem As CommandBarControl

Const MenuCaption = "NyMenu"
Const UnderMenuCaption = "NyUndermenu"

Public Sub NyMenu()
    Dim bMenuExists As Boolean
    Dim ctrl1 As CommandBarButton
    Dim mnuNyUndermenuLocal As CommandBarButton
    Dim MenuItem As CommandBarControl
    Dim LocalMenuItem As CommandBarControl
    Dim MenuBar As CommandBar
    Dim strPreKode As String

    Set MenuBar = Application.CommandBars.ActiveMenuBar
    bMenuExists = False

    MenuBar.Reset
   
    For Each MenuItem In MenuBar.Controls
        If MenuItem.Caption = MenuCaption Then
            bMenuExists = True
            Set LocalMenuItem = MenuItem
            Set mnuNyUndermenuLocal = MenuItem.CommandBar.Controls(UnderMenuCaption)
        End If
    Next MenuItem
   
    If Not bMenuExists Then
        Set LocalMenuItem = MenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        LocalMenuItem.Move Before:=10
        LocalMenuItem.Caption = MenuCaption
        Set ctrl1 = LocalMenuItem.CommandBar.Controls.Add(Type:=msoControlButton, ID:=1, Temporary:=True)
        With ctrl1
          .Caption = UnderMenuCaption
          .Style = msoButtonCaption
          .OnAction = "Navnetpådinmakro"
        End With
    Set NewMenuItem = LocalMenuItem
       
        If CheckTemplate Then
        NewMenuItem.Enabled = False
    End If
       
End If
   
End Sub

Public Sub SletMenu()
    If Not NewMenuItem Is Nothing Then
        On Error Resume Next
        NewMenuItem.Delete
        On Error GoTo 0
        Set NewMenuItem = Nothing
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    SletMenu
End Sub

Private Sub Workbook_Activate()
    NyMenu
End Sub

Private Sub Workbook_Deactivate()
    SletMenu
End Sub

Private Sub Workbook_Open()
    NyMenu
End Sub

Private Function CheckTemplate() As Boolean
    Dim bResult As Boolean
    bResult = False
    If UCase(Application.ActiveWorkbook.Name) = "TEMPLATE.XLS" Then
        bResult = True
    End If
    CheckTemplate = bResult
End Function

Public Sub TrigMenu(shtWorkSheet As Worksheet)
    Workbook_SheetActivate shtWorkSheet
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    NyMenu
End Sub