How to assign a macro to a custom menu VBA?

Question

I'm trying to create a custom menu with buttons that have macros assign to them so that the end user doesn't need to do anything except run it. I have the installer as add in and code in ThisWorkbook that will run on open event everything runs perfectly but the problem is the buttons don't work except for the RemoveButtons that removes the add in altogether. Maybe i'm doing something wrong here. The code is in a standard module.

Private Sub AddButtons()


    Const MyControl As String = "Applications..."

    Const MyControlCaption As String = "Manage Applications"

    Dim AddinTitle As String, Mybar As Object

    AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

    Call RemoveButtons

    On Error GoTo ErrHandler
    Set Mybar = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls _
    .Add(Type:=msoControlPopup, before:=13)

    With Mybar
        .BeginGroup = True
        .Caption = MyControl
         '-------------------------------------------------------------
        .Controls.Add.Caption = MyControlCaption
        .Controls(MyControlCaption).OnAction = "ShowStartupForm"
         '-------------------------------------------------------------
        With .Controls.Add(Type:=msoControlButton)
            .BeginGroup = True
            .Caption = "About " & AddinTitle
        End With
        .Controls("About " & AddinTitle).OnAction = "ShowAboutForm"
         '-------------------------------------------------------------
        .Controls.Add.Caption = "Remove " & AddinTitle
        .Controls("Remove " & AddinTitle).OnAction = "RemoveAddIn"
        .Controls.Add.Caption = "Edit " & AddinTitle
        .Controls("Edit " & AddinTitle).OnAction = "EditSheets"
         '-------------------------------------------------------------
    End With
    Exit Sub

ErrHandler:
    Set Mybar = Nothing
    Set Mybar = Application.CommandBars("Tools") _
    .Controls.Add(Type:=msoControlPopup, before:=13)
    Resume Next
End Sub


Private Sub RemoveButtons()


    Const MyControl As String = "Applications..."

    On Error Resume Next
    With Application
        .CommandBars("Tools").Controls(MyControl).Delete
        .CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls(MyControl).Delete
    End With

End Sub

Answer 1

i show you an example of code i am using, you can use the bits you need... This is a shortened version of a on right clic sub :

Option Explicit

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim MySubMenu As CommandBarControl
Cancel = True

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    '.Calculation = xlCalculationManual 'cuts copy
End With

Application.CommandBars("Cell").Reset

Set MySubMenu = Application.CommandBars("Cell").Controls.add(Type:=msoControlPopup, before:=1)
    With MySubMenu
        .Caption = "Heroes && Beasts"
        .Tag = "Hefffffsts"

        With .Controls.add(Type:=msoControlButton)
                .Caption = "Importer l'Objet vers l'Inventaire Global."
                .FaceId = 51
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Vers_Inventaire_show" '"Vers_INV"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Importer l'Objet vers le Fichier Marchand/Vendeur."
                .FaceId = 52
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Vers_Marchand"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Corriger Taille Ligne (Autofit + //Image)."
                .FaceId = 164 '338
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Set_Row_Height_To_Pic"
                .BeginGroup = True
        End With

        With .Controls.add(Type:=msoControlButton)
                .Caption = "Vérifier doublons de noms et recentrer toutes les images."
                .FaceId = 620 '550 '735 '999 '995
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "sheet_deactiv_public"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Mettre à jour le Format des Cellules de la Page."
                .FaceId = 791 '962 '661 ' 513 ' 439
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Verif_Format_Page2"
        End With


            With .Controls.add(Type:=msoControlButton, before:=1 + trouve_pos(22, "Paste"))
                .Caption = "Insérer Ligne (par le dessus)."
                .FaceId = 15
                .OnAction = "'" & ThisWorkbook.Name & "'!'InsertLine_Menu_deroulant'"
            End With

                With .Controls.add(Type:=msoControlButton) ', before:=,)
                    .Caption = "Afficher l'Interface."
                    .OnAction = "'" & ThisWorkbook.Name & "'!'Interface_Show2'"
                    .FaceId = 642 '343'611
                End With

        End With


        With .Controls.add(Type:=msoControlButton)
                .Caption = "Refaire icones d'objets du menu déroulant."
                .FaceId = 734 '962 '703 '965 '558
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Memoriser_Objets"
        End With
         With .Controls.add(Type:=msoControlButton)
                .Caption = "Vérifier si il y a des Images trop Grandes."
                .FaceId = 990 '273 '642
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Verif_Tailles_Images"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Classer les objets par Rang (+0 à +6) - (Béta v3)"
                .TooltipText = "Ne traite pas (encore) le classement par prix"
                .FaceId = 11 '304
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Ranger_Lignes_Par_Rang"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Classer les objets par Prix (Béta v1)"
                .FaceId = 304
                .TooltipText = "Le classement par Rang DOIT déjà être fait avant."
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Trier_Page_par_prix"
        End With
        With .Controls.add(Type:=msoControlButton)
                .Caption = "Classer les objets par Rang, et Prix"
                .FaceId = 451 ' 658 ' 703
                '.TooltipText = "Le classement par Rang DOIT déjà être fait avant."
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Trier_Page_par_rang_et_prix"
        End With
    End With

With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .CommandBars("Cell").ShowPopup
End With

Application.CommandBars("Cell").Reset
Set MySubMenu = Nothing
End Sub

some of your coding is very missleading .

Each time you use .controls.add, you should either put it in a variable (by using set XXX=...) , or use with.

Answer 2

Go to Options. Click Trust Center, and then click Trust Center Settings. In the Trust Center, click Macro Settings. then select "Enable all macros"