Generare una barra di Sottomenu con vba

Question

Chiedo il Vostro aiuto perche mi sto perdendo ..... :( ......

Con la Routine che pubblicherò sotto riesco a generare una "Barra menu di scelta rapida"  

(NON parlo di Ribbon,   bensi della barra  che si attiva con il Klik Dx sul mause)

Vorrei nel pulsante centrale aggiungere 2 sottomenu

Ringrazio chi potrà mettermi sulla strada giusta

<code>

Private Sub CreaMenu()

'  necessario riferimento    Microsoft Office 15.0 Object Library

'  devo lanciare a mano questa Sub,  dopo posso anche eliminarla e rimuovere il riferimento

'        se va in "errore di rutime 5" allora significa che esiste gia la barra,  devi eliminarla e ricrearla

    ' _____ Definisco la Barra di scelta rapida ( Clik Dx )

    Dim CommBar As Office.CommandBar

    Set CommBar = CommandBars.Add(Name:="NuovaBarra", Position:=msoBarPopup, MenuBar:=False, temporary:=False)

    ' _____ Ci metto  3 pulsanti personalizzati

    Dim Pulsante

    Set Pulsante = CommBar.Controls.Add(Type:=msoControlButton)

        With Pulsante

            .FaceId = 133

            .OnAction = "PuPe1"

            .Caption = "Pulsante Personalizzato 1"

        End With

    Set Pulsante = CommBar.Controls.Add(Type:=msoControlButton)

        With Pulsante

            .FaceId = 134

            .OnAction = "PuPe2"

            .Caption = "Pulsante Personalizzato 2"

            .BeginGroup = True

        End With

    Set Pulsante = CommBar.Controls.Add(Type:=msoControlButton)

        With Pulsante

            .FaceId = 135

            .OnAction = "PuPe3"

            .Caption = "Pulsante Personalizzato 3"

        End With

    Set Pulsante = Nothing

    Set CommBar = Nothing

End Sub

Public Sub PuPe1()

    MsgBox ("Premuto il Pulsante Personalizzato 1")

    '  Call ..... i suoi eventi

End Sub

Public Sub PuPe2()

    MsgBox ("Premuto il Pulsante Personalizzato 2")

    '  Call ..... i suoi eventi

End Sub

Public Sub PuPe3()

    MsgBox ("Premuto il Pulsante Personalizzato 3")

    '  Call ..... i suoi eventi

End Sub

</code>

Answer 1

ciao Mancini,

come siamo qui : https://answers.microsoft.com/it-it/msoffice/forum/all/creazioe-da-codice-di-tabella-collegata-mi/0b964333-9560-4df1-8f9d-2a9c8bc5e656

per questo nuovo 3d, prova come segue :

Private Sub CreaMenu()

    Dim CommBar  As Object ' Office.CommandBar

    Dim Pulsante As Object ' Office.CommandBarControl

    Dim sMenu    As Object ' Office.CommandBarControl

    Set CommBar = CommandBars.Add(Name:="NuovaBarra", Position:=5, MenuBar:=False, temporary:=False) '5=msoBarPopup

    With CommBar

        Set Pulsante = .Controls.Add(Type:=1) '1=msoControlButton

        With Pulsante

            .FaceId = 133

            .OnAction = "PuPe1"

            .Caption = "Pulsante Personalizzato 1"

        End With

    Set sMenu = .Controls.Add(Type:=10) '10=msoControlPopup

    With sMenu

            .Caption = "Pulsante Personalizzato 2"

            Set Pulsante = .Controls.Add(Type:=1) '1=msoControlButton

            With Pulsante

                .FaceId = 134

                .OnAction = "PuPe2"

                .Caption = "Pulsante Personalizzato sottomenu1"

                .BeginGroup = True

            End With

            Set Pulsante = .Controls.Add(Type:=1) '1=msoControlButton

            With Pulsante

                .FaceId = 134

                .OnAction = "PuPe2"

                .Caption = "Pulsante Personalizzato sottomenu2"

                .BeginGroup = True

            End With

    End With

    Set Pulsante = .Controls.Add(Type:=1) '1=msoControlButton

        With Pulsante

            .FaceId = 135

            .OnAction = "PuPe3"

            .Caption = "Pulsante Personalizzato 3"

        End With

 End With

 Set Pulsante = Nothing

 Set CommBar = Nothing

 Set sMenu = Nothing

End Sub

Facci sapere.

Ciao, Sandro.

Answer 2

Ok,    Grazie,  è esattamente quello che cercavo ...... :) .......

(per il vecchio ho risposto sul vecchio)

.