sous menu dans une barre de menu

[THE DBX]

Bonjour,

Je cherche à mettre un sous menu dans une barre de menu...... voici le prog (récupéré dans un autre prog) :

==========================================================================================================
Option Private Module

Public Const BarreDBX = "BarreDBX"

Const Proc1 = "BarreDBXProc1"
Const Proc2 = "BarreDBXProc2"
Const Proc3 = "BarreDBXProc3"
Const Proc4 = "BarreDBXProc4"
Const Proc5 = "BarreDBXProc5"
Const Proc6 = "BarreDBXProc6"
Const Proc7 = "BarreDBXProc7"
Const Proc8 = "BarreDBXProc8"
Const Proc9 = "BarreDBXProc9"
Const Proc10 = "BarreDBXProc10"
Const Proc11 = "BarreDBXProc11"
Const Proc12 = "BarreDBXProc12"
Const Proc13 = "A_Propos"

Const CaptionBarre = "Barre DBX..."

Const Caption1 = "Accueil"
Const Caption2 = "Détails intervention"
Const Caption3 = "Maintenance"
Const Caption4 = "Feuille de relevés"
Const Caption5 = "Carnet d'entretien"
Const Caption6 = "Design Station"
Const Caption7 = "Matériels à commander"
Const Caption8 = "Tableau de données"
Const Caption9 = "Graphiques"
Const Caption10 = "Réglages d'origine"
Const Caption11 = "Affichage : 800x600"
Const Caption12 = "Affichage : 1024x768"
Const Caption13 = "A propos..."

Const TipTextBarre = "Accès Directs"

Sub CreeBarreMenu()
Dim LBar As CommandBar, LBouton As CommandBarPopup
Dim LitemBouton As CommandBarButton
Dim StyleBouton As Long

On Error Resume Next
Set LBar = CommandBars(BarreDBX)
On Error GoTo 0
If Not LBar Is Nothing Then Exit Sub

StyleBouton = msoButtonCaption

Set LBar = CommandBars.Add(Name:=BarreDBX, _
Position:=msoBarRight, temporary:=True)

Set LBouton = LBar.Controls.Add(Type:=msoControlPopup)
With LBouton
.Caption = CaptionBarre
.TooltipText = TipTextBarre

'Accueil
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.Caption = Caption1
.Style = StyleBouton
.OnAction = Proc1
End With

'Détails intervention
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = True
.Caption = Caption2
.Style = StyleBouton
.OnAction = Proc2
End With

'Maintenance
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption3
.Style = StyleBouton
.OnAction = Proc3
End With

'Feuille de relevés
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption4
.Style = StyleBouton
.OnAction = Proc4
End With

'Carnet d'entretien
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption5
.Style = StyleBouton
.OnAction = Proc5
End With

'Design Station
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption6
.Style = StyleBouton
.OnAction = Proc6
End With

'Matériel à commander
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption7
.Style = StyleBouton
.OnAction = Proc7
End With

'Tableau de données
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = True
.Caption = Caption8
.Style = StyleBouton
.OnAction = Proc8
End With

'Graphiques
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = False
.Caption = Caption9
.Style = StyleBouton
.OnAction = Proc9
End With

'Réglages d'origine
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = True
.Caption = Caption10
.Style = StyleBouton
.OnAction = Proc10
End With

'800x600
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = True
.Caption = Caption11
.Style = StyleBouton
.OnAction = Proc11
End With

'1024x768
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
'.BeginGroup = True
.Caption = Caption12
.Style = StyleBouton
.OnAction = Proc12
End With

'A propos...
Set LitemBouton = .Controls.Add(Type:=msoControlButton)
With LitemBouton
.BeginGroup = True
.Caption = Caption13
.Style = StyleBouton
.OnAction = Proc13
End With

End With
LBar.Visible = False
End Sub

Sub SupprimeBarreMenu()
Dim LBar As CommandBar
On Error Resume Next
CommandBars(BarreDBX).Delete
End Sub

Private Sub BarreDBXProc1()
Call accueil
End Sub
Private Sub BarreDBXProc2()
Call page3
End Sub
Private Sub BarreDBXProc3()
Call page1
End Sub
Private Sub BarreDBXProc4()
Call page2
End Sub
Private Sub BarreDBXProc5()
Call page6
End Sub
Private Sub BarreDBXProc6()
Call page5
End Sub
Private Sub BarreDBXProc7()
Call page4
End Sub
Private Sub BarreDBXProc8()
Call page9
End Sub
Private Sub BarreDBXProc9()
Call page10
End Sub
Private Sub BarreDBXProc10()
Call page7
End Sub
Private Sub BarreDBXProc11()
Call ZOOM_800x600
End Sub
Private Sub BarreDBXProc12()
Call ZOOM_1024x768
End Sub
Private Sub A_Propos()
A_Propos_CRV.Show
End Sub
==========================================================================================================



Merci....


DBX

 

[Romuald]

Et ça ne marche pas?

De manière peut-être plus simple, le code pour créer un menu et des sous-menus est le suivant :

Dim cmbMenuBar As CommandBar
Dim cbcSubMenuBar As CommandBarControl

Set cmbMenuBar = CommandBars.ActiveMenuBar
Set cbcMenuSYMBAD = cmbMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)

' Création du menu
cbcMenuSYMBAD.Caption = "Mon menu"

' Création d'un sous-menu (ou d'un sous-sous-menu)
Set cbcSubMenuBar = cbcMenuSYMBAD.Controls.Add(Type:=msoControlButton, ID:=1)
cbcSubMenuBar.BeginGroup = True
cbcSubMenuBar.Caption = "Disconnect..."
cbcSubMenuBar.OnAction = "Logout"

 

[Ti]

pourquoi n'avoir pas laissé le nom de l'auteur d'origine du code que tu as récupéré ? C'est, me semble-t-il, la moindre des politesses vis-à-vis de celui-ci, et ne va pas me dire que tu ne l'as pas...

 

[THE DBX]

Salut Ti,

Ca fait 2 fois que tu me le dis mais j'ai pris ce code depuis mon fichier excel qui n'a plus trop de commentaire (dont les auteurs.... désolé pour eux) mais c'est vrai que c'est un code que j'ai repris et adapté.... comme tout le monde !

PS..... merci Romuald pour ta réponse.
PS bis....Je laisserai les commentaires avec tout ceux qui participeront à la nouvelle version de mon prog "Compte rendu de visite".......

Salutations

DBX

 

[ludovic]

Bonjour Romuald et le forum,

J'intervient par rapport à ta reponse, dans ton script, tu préciseTemporary:=True

est ce que ceci permet de supprimer le menu a la fermeture d'Excel ?

Merci pour le renseignement
Ludo