OnCaption d'un boutonRésolu

Question

Bonjour à tous,

J'ai un petit soucis dans mon code. J'ai créé un bouton afin d'appeler une userform par ce code : 

'Insertion sur la barre de menus du bouton de commande "Tri des fournisseurs par nombre de consultations"
Set MonBouton2 = MaBarre.Controls.Add(msoControlButton)
With MonBouton2
    .Style = msoButtonIconAndCaption
    .FaceId = 591
    .Caption = "Tri des fournisseurs"
    .TooltipText = "Trier les fournisseurs par nombre de consultations"
End With

End Sub

Sub UserForm_1()
    UserForm1.Show
End Sub

Le problème est que rien ne se passe... Quelqu'un peut'il m'aider ?

cs_Le Pivert · Accepted Answer

Après diverses recherches sur le Net: "Création bouton Outlook VBA", j'ai trouvé ceci:

Mettre dans un module
Sub L_lancer()
UserForm1.Show
End Sub
Sub BarOutil()
Dim mesBarres As CommandBars
Dim mabarre As CommandBar
Dim MaBarre2 As CommandBar
Dim lebouton As CommandBarButton

Set mesBarres = ActiveExplorer.CommandBars ' La collection des barres et menus de Outlook
For Each mabarre In mesBarres ' recherche de la barre Essai de barre
If mabarre.NameLocal = "Essai de barre" Then
Set MaBarre2 = mabarre
End If
Next
If MaBarre2 Is Nothing Then ' la barre n'a pas été trouvée, on la crée
Set MaBarre2 = mesBarres.Add("Essai de barre")
Set lebouton = MaBarre2.Controls.Add(msoControlButton)
MsgBox "Création barre"
End If
Set lebouton = MaBarre2.Controls(1) ' accès au 1er bouton de la barre
lebouton.Caption = "Mon bouton à moi" ' affectation du nom du bouton
lebouton.TooltipText = "C'est mon bouton à moi" ' affectation de l'infobulle du bouton
lebouton.OnAction = "L_lancer" ' affectation de la macro à effectuer, ici NbMessEnvSupp
'du code de session Outlook
MaBarre2.Position = msoBarTop ' positionnement de la barre
MaBarre2.Protection = msoBarNoMove + msoBarNoCustomize ' Protection de la barre, pour ne pas pouvoir la déplacer ni la
'modifier
MaBarre2.Visible = True ' on la rend visible
End Sub

Mettre dans ThisOutlookSession
Private Sub Application_Startup()
  BarOutil
End Sub


Cela fonctionne, maintenant à vous de l'adapter à votre projet
@+ Le Pivert

cs_Le Pivert · Answer

Bonjour,

Essayez ceci:

'Insertion sur la barre de menus du bouton de commande "Tri des fournisseurs par nombre de consultations"
Set MonBouton2 = MaBarre.Controls.Add(msoControlButton)
With MonBouton2
    .Style = msoButtonIconAndCaption
    .FaceId = 591
    .OnAction = UserForm_1
    .Caption = "Tri des fournisseurs"
    .TooltipText = "Trier les fournisseurs par nombre de consultations"
End With

End Sub

Sub UserForm_1()
    UserForm1.Show
End Sub

@+

cs_Le Pivert · Answer

Rectification


.OnAction = "UserForm_1"

j'avais oublié les quillemets

ptitemeuh · Answer

Bonjour,

Je viens de modifier le code, malheureusement rien ne s'affiche. 

Je travaille avec le logiciel Outlook 2003 mais je suppose que le code en visual basic ne change pas suivant le type de logiciel tel que word, excel ou encore powerpoint ?

cs_Le Pivert · Answer

J'ai fait cela sous Excel pour créer un bouton:

Dans un module mettre:
 
Sub CreeMonBouton()
  Set bar = Application.CommandBars("Standard")
  With bar.Controls.Add(msoControlButton, , , , True)
     .Style = msoButtonIconAndCaption
    .FaceId = 591
    .OnAction = "L_lancer"
    .Caption = "Tri des fournisseurs"
    .TooltipText = "Trier les fournisseurs par nombre de consultations
  End With
 
End Sub
Sub L_lancer()
UserForm1.Show
End Sub


Et dans ThisWorbook mettre:

Option Explicit

Private Sub Workbook_Open()
   CreeMonBouton
   End Sub
 J'ai essayer sous Outlook, mais je n'ai pas l'habitude et je n'ai pas pu démarrer la macro.
@+ Le Pivert

ptitemeuh · Answer

Bonjour,

J'ai utilisé : Private Sub Application_Startup() afin qu'à l'ouverture du logiciel, ma barre d'outils ainsi que mes boutons se créés.

Private Sub Application_Startup()
  Set bar = Application.CommandBars("Standard")
  With bar.Controls.Add(msoControlButton, , , , True)
     .Style = msoButtonIconAndCaption
    .FaceId = 591
    .OnAction = "L_lancer"
    .Caption = "Tri des fournisseurs"
    .TooltipText = "Trier les fournisseurs par nombre de consultations
  End With
End Sub

Sub L_lancer()
UserForm1.Show
End Sub

Rien ne s'affiche également 

J'ai essayé également UserForm1.Visible mais rien ne se passe.

cs_Le Pivert · Answer

Cela ne change rien de changer le nom du module, c'est dans le code contenu dans ThisWorbook dans Excel que l' action est appelée. Mais dans Outlook il faut le mettre dans ThisOutlookSession, mais je ne connais pas le code pour l'appeler.
Mais est-bien un bouton dans le menuBar que vous voulez mettre ou une barre d'outils car ce n'est pas la même chose?
Voici le code pour créer une baroutils:

Option Explicit

Sub CreateMenu()
'crée un nouveau menu.
'peut aussi être utilisé pour créer commandbarbuttons
'peut être automatiquement exécuté d'une macro Auto_Open ou d'un Workbook_Open eventmacro
 
Dim cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
    RemoveMenu 'effacez le menu s'il existe déjà
    'créez un nouveau menu sur commandbar existant (les 6 lignes suivantes)
    Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&Mon menu"
        .Tag = 1
        .BeginGroup = False
    End With
   'ou ajoutez à un menu existant (utilisez la ligne suivante au lieu des 6 lignes précédentes)
    'Le jeu cbMenu = l'Application. CommandBars. FindControl (, 30007)' le Menu d'instruments
    If cbMenu Is Nothing Then Exit Sub 'n'a pas trouvé le menu...


    'ajoutez menuitem au menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Ouvrir l'application"
        .Tag = 2
        .OnAction = "L_Lancer" 'on lance l'action
     'Icône
     .FaceId = 9161
     'Séparation
     .BeginGroup = True
    End With


  'ajoutez menuitem au menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Accès aux codes de l'application"
      .Tag = 3
      .OnAction = "L_VBA" 'on lance l'action
     'Icône
    .FaceId = 1695
     'Séparation
     .BeginGroup = True
    End With

  'ajoutez menuitem au menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Quitter"
       .OnAction = "L_Quitter" 'on lance l'action
     'Icône
    .FaceId = 9724
     'Séparation
     .BeginGroup = True
    End With
    
    'ajoutez menuitem au menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&A Propos"
      .Tag = 3
      .OnAction = "L_Propos" 'on lance l'action
     'Icône
    .FaceId = 9325
     'Séparation
     .BeginGroup = True
    End With
   
    Set cbSubMenu = Nothing
    Set cbMenu = Nothing
End Sub

Sub RemoveMenu()
'peut être automatiquement exécuté d'une macro Auto_Close ou d'un Workbook_BeforeClose eventmacro
DeleteCustomCommandBarControl "MyTag" 'efface le nouveau menu
End Sub

Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
'efface TOUT occurences de commandes de commandbar avec une étiquette = CustomControlTag
On Error Resume Next
    Do
        Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
    Loop Until Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
    On Error GoTo 0
End Sub

Sub ShowHideMenu(MenuVisible As Boolean)
'peut être automatiquement exécuté d'une macro Workbook_Activate ou d'un Workbook_Deactivate eventmacro
     ChangeControlVisibility "MyTag", MenuVisible 'visibilité de menu de boutons
End Sub

Private Sub ChangeControlVisibility(CustomControlTag As String, MenuVisible As Boolean)
'visibilité de menu de boutons
    On Error Resume Next
    Application.CommandBars.FindControl(, , CustomControlTag, False).Visible = MenuVisible
    On Error GoTo 0
End Sub
Sub L_Lancer()
UserForm1.Show vbModeless 'Lance la macro
End Sub
Sub L_Propos()
UserForm2.Show vbModeless 'Lance la macro
End Sub
Sub L_VBA()
On Error Resume Next
SendKeys "%{F11}"  'ouvre le programme 'alt F11'
End Sub
Public Sub L_Quitter()
On Error Resume Next
CommandBars(1).Controls("Mon menu").Delete
ThisWorkbook.Close
End Sub



Tout cela se lance dans le ThisWorbook avec :

Option Explicit

Private Sub Workbook_Activate()
    ShowHideMenu True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    RemoveMenu
End Sub

Private Sub Workbook_Deactivate()
    ShowHideMenu False
End Sub

Private Sub Workbook_Open()
    CreateMenu
   
End Sub


@+

ptitemeuh · Answer

Salut,

Wouaaahhh merci beaucoup pour ton aide précieuse, je commençais à désespérer devant mon bout de code. J'ai adapté à mon projet et tout fonctionne parfaitement bien 
Encore un grand MERCI 

Bonne soirée

OnCaption d'un bouton

8 réponses

Votre réponse

Discussions similaires