Makro Opret Table Of Contest i menulinien

Hej igen - "tak for sidst".

Har for år siden konstrueret noget der ligner - blot til Word.

Kunne man ikke forestille sig - at du blot oprettede arkene og så blev "menuen" automatisk opdateret? Det var princippet i word-løsningen - dog her mapper og undermapper m/diverse filer.

I lige måde ...

Jeg er da åben overfor alt :-) ...

Jeg har behov for en mere sigende tekst til selve linket, i min nuværende version, har jeg denne stående i celle A1 i alle de ark jeg vil medtage i "Table Of Contest", men ellers er det ok, at den genereres pr. automatik

Rem Koden kopieres & anbringes i ThisWorkbook + en enkelte sub i Module1
Rem ====================================================================
Dim MenuObject As CommandBarPopup
Dim SubMenu As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton

Const strMenuName As String = "Table Of Contest"
Const strMenuNo As String = 11
Const intBarsNo As Integer = 1
Private Sub workbook_activate()
    xlAutoOpen
End Sub
Public Sub xlAutoOpen()
Rem Sletter tidligere menu-system
    DeleteMenu strMenuName, intBarsNo

Rem Hovedmenu
    CreateMainMenu strMenuName, strMenuNo, intBarsNo
   
Rem Undersøger mapper for ark-id
    traverserArk
End Sub
Public Sub xlAutoClose()
    AutoOpen                                      '-"-
End Sub
Public Sub xlAutoExec()
    AutoOpen                                        '-"-
End Sub
Public Sub xlAutoNew()
    AutoOpen                                        '-"-
End Sub
Private Sub traverserArk()
Dim ark, menuPunkt As String
    For Each ark In ActiveWorkbook.Sheets
        menuPunkt = ark.Cells(1, 1)
'        CreateSubMenu menuPunkt, True
        CreateMenuItem menuPunkt, "module1.MenuX", True, True, ark.Name
    Next ark
End Sub
Sub DeleteMenu(strMenuName As String, intBarsNo As Integer)
    On Error Resume Next
            Application.CommandBars("Worksheet Menu Bar").Controls(strMenuName).Delete
    On Error GoTo 0
End Sub
Private Sub CreateMainMenu(strMenuName, strMenuNo As String, intBarsNo As Integer)
    Set MenuObject = Application.CommandBars("WorkSheet Menu Bar").Controls.Add(Type:=msoControlPopup, _
                    Before:=strMenuNo, Temporary:=False)
        MenuObject.Caption = strMenuName
End Sub
Private Sub CreateMenuItem(strCaption, strOnAction, strFaceId As String, bolBeginGroup As Boolean, arkNavn)
    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
        With MenuItem
            .Caption = strCaption
            .OnAction = strOnAction
            .BeginGroup = bolBeginGroup
            .Tag = arkNavn
        End With
End Sub
Rem I module1
Private Sub MenuX()
Dim valgteArk
    valgteArk = CommandBars.ActionControl.Tag
    ActiveWorkbook.Sheets(valgteArk).Activate
End Sub