R15930 [VBA] Création de menu dans outlook
Publié par Trarc91 le Mardi 09 novembre 2010 23:38

' ======================================================================================
'Description : Ensemble d'exemples pour créer un menu dans barre de menu ou dans une barre d'outil
'Auteur 1 : Starec - Philippe JOCHMANS - http://starec.developpez.com
'Auteur 2 : Fred (fring) - http://developpez.com
'Regroupé & adapté par : Marc Trémel
'=======================================================================================

'---------------------------------------------------------------------------------------
Sub ListeMenu()
Dim ObjOut As Outlook.Explorer
Dim Cbars As CommandBars, Cbar As CommandBar
Set ObjOut = Outlook.ActiveExplorer
Set Cbar = ObjOut.CommandBars.Item("Menu Bar")
'Cbar.Reset '<-- Retour à l'état initial
'Cbar.Protection = msoBarNoProtection '<-- Supprime la protection
For Each ctrl In Cbar.Controls
Debug.Print ctrl.Caption

Next ctrl
End Sub

'---------------------------------------------------------------------------------------
Sub Menus_perso()
'déclaration des variables
Dim ObjOut As Outlook.Explorer
Dim Cbars As CommandBars, Cbar As CommandBar, Cbut As CommandBarButton
Dim Ctxt As CommandBarComboBox, Cpop1 As CommandBarPopup, Cpop2 As CommandBarPopup
Dim x As Byte

Set ObjOut = Outlook.ActiveExplorer
Set Cbar = ObjOut.CommandBars.Item("Menu Bar")
Cbar.Protection = msoBarNoProtection

For Each ctrl In Cbar.Controls
If ctrl.Caption = "Menu" Then
Exit Sub
End If
Next

Set Cpop1 = Cbar.Controls.Add(msoControlPopup)
With Cpop1
.Caption = "Menu" '<-- label du sous-menu
.BeginGroup = True
.Tag = "m1" '<-- étiquette
End With

'insertion dans le menu d'un premier bouton de commande
Set Cbut = Cpop1.Controls.Add(msoControlButton)
With Cbut
.FaceId = 358 '<-- icône
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "Supprimer Menu" '<-- label du bouton
.OnAction = "SuppMenu" '<-- procédure à exécuter
.Tag = "sm1cbut1" '<-- étiquette
End With

'insertion dans le menu d'un second bouton de commande
Set Cbut = Cpop1.Controls.Add(msoControlButton)
With Cbut
.Style = msoButtonCaption '<-- bouton avec texte uniquement
.Caption = "Bouton 2" '<-- label du bouton
.OnAction = "Macro4" '<-- procédure à exécuter
.Tag = "sm1cbut2" '<-- étiquette
End With

'insertion dans le menu d'un sous-menu
Set Cpop2 = Cpop1.Controls.Add(msoControlPopup)
With Cpop2
.Caption = "Sous-menu" '<-- label du sous-menu
.Tag = "sm2" '<-- étiquette
End With

'insertion dans le sous-menu d'un bouton prédéfini ouvrant l'application Word
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 42
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "Word" '<-- label du bouton
End With

'insertion dans le sous-menu d'un bouton prédéfini ouvrant l'application Access
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 264
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "Access" '<-- label du bouton
End With

'insertion dans le sous-menu d'un bouton prédéfini ouvrant l'application PowerPoint
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 267
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "PowerPoint" '<-- label du bouton
End With
End Sub


'---------------------------------------------------------------------------------------
Sub SuppMenu()
Dim ObjOut As Outlook.Explorer
Dim Cbars As CommandBars, Cbar As CommandBar
Set ObjOut = Outlook.ActiveExplorer
Set Cbar = ObjOut.CommandBars.Item("Menu Bar")
Cbar.Protection = msoBarNoProtection
For Each ctrl In Cbar.Controls
If ctrl.Caption = "Menu" Then
ctrl.Delete
End If
Next ctrl
End Sub

'---------------------------------------------------------------------------------------
Sub Barre_menus_perso()
'déclaration des variables
Dim Cbars As CommandBars, Cbar As CommandBar, Cbut As CommandBarButton
Dim Ctxt As CommandBarComboBox, Cpop1 As CommandBarPopup, Cpop2 As CommandBarPopup
Dim x As Byte

Set Cbars = ActiveExplorer.CommandBars 'Collection des barres et menus de Outlook
For Each Cbar In Cbars 'Recherche de la barre "Nom_de_la_Barre"
If Cbar.NameLocal = "Nom_de_la_Barre" Then
Cbar.Visible = True
Exit Sub
End If
Next
'Création de la barre d'outils
Set Cbar = Cbars.Add("Nom_de_la_Barre")

'insertion sur la barre de menus d'un bouton de commande
Set Cbut = Cbar.Controls.Add(msoControlButton)
With Cbut
.FaceId = 358 '<-- icône
.Style = msoButtonIconAndCaption
.OnAction = "SuppBarre" '<-- procédure à exécuter
.TooltipText = "Suppression barre de menus" '<-- info-bulle
.Tag = "cbut1" '<-- étiquette
End With

'insertion sur la barre de menus d'une zone de texte
Set Ctxt = Cbar.Controls.Add(msoControlEdit)
With Ctxt
.Style = msoComboLabel '<-- zone de texte avec label
.Caption = "Date :" '<-- texte du label
.TooltipText = "Veuillez introduire une date" '<-- info-bulle
.OnAction = "Macro2" '<-- procédure à exécuter
.BeginGroup = True '<-- barre de séparation
.Tag = "ctxt1" '<-- étiquette
End With

'insertion sur la barre de menus d'une zone de liste
Set Ctxt = Cbar.Controls.Add(msoControlDropdown)
With Ctxt
.Style = msoComboLabel '<-- zone de liste avec label
.Caption = "Liste :" '<-- texte du label
.TooltipText = "Faites votre choix" '<-- info-bulle
.OnAction = "Macro3" '<-- procédure à exécuter
.BeginGroup = True '<-- barre de séparation
.Tag = "clist1" '<-- étiquette
For x = 1 To 5
.AddItem ("Choix " & x) '<-- ajout de 5 Item
Next
End With

'insertion sur la barre de menus d'un sous-menu 1
Set Cpop1 = Cbar.Controls.Add(msoControlPopup)
With Cpop1
.Caption = "Sous-menu 1" '<-- label du sous-menu
.Tag = "sm1" '<-- étiquette
End With

'insertion dans le sous-menu 1 d'un premier bouton de commande
Set Cbut = Cpop1.Controls.Add(msoControlButton)
With Cbut
.Style = msoButtonCaption '<-- bouton avec texte uniquement
.Caption = "Bouton 1" '<-- label du bouton
.OnAction = "Macro4" '<-- procédure à exécuter
.Tag = "sm1cbut1" '<-- étiquette
End With

'insertion dans le sous-menu 1 d'un second bouton de commande
Set Cbut = Cpop1.Controls.Add(msoControlButton)
With Cbut
.Style = msoButtonCaption '<-- bouton avec texte uniquement
.Caption = "Bouton 2" '<-- label du bouton
.OnAction = "Macro4" '<-- procédure à exécuter
.Tag = "sm1cbut2" '<-- étiquette
End With

'insertion dans le sous-menu 1 d'un sous-menu 2
Set Cpop2 = Cpop1.Controls.Add(msoControlPopup)
With Cpop2
.Caption = "Sous-menu 2" '<-- label du sous-menu
.Tag = "sm2" '<-- étiquette
End With

'insertion dans le sous-menu 2 d'un bouton prédéfini ouvrant l'application Word
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 42
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "Word" '<-- label du bouton
End With

'insertion dans le sous-menu 2 d'un bouton prédéfini ouvrant l'application Access
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 264
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "Access" '<-- label du bouton
End With

'insertion dans le sous-menu 2 d'un bouton prédéfini ouvrant l'application PowerPoint
Set Cbut = Cpop2.Controls.Add(msoControlButton)
With Cbut
.FaceId = 267
.Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
.Caption = "PowerPoint" '<-- label du bouton
End With

Cbar.Position = msoBarTop
Cbar.Protection = msoBarNoMove + msoBarNoCustomize '<-- protection de la barre de menus
Cbar.Visible = True '<-- affichage de la barre de menus
End Sub

'---------------------------------------------------------------------------------------
Sub SuppBarre()
'déclaration des variables
Dim Cbars As CommandBars, Cbar As CommandBar

Set Cbars = ActiveExplorer.CommandBars 'Collection des barres et menus de Outlook
For Each Cbar In Cbars 'Recherche de la barre "Nom_de_la_Barre"
If Cbar.NameLocal = "Nom_de_la_Barre" Then
Cbar.Delete
End If
Next
End Sub

De la part d'un généreux membre Trarc91 pour qui le partage n'est pas un vain mot.

MERCI !