OnCaption d'un bouton [Résolu]

ptitemeuh
Messages postés
83
Date d'inscription
jeudi 4 février 2010
Dernière intervention
8 juillet 2010
- 10 mai 2010 à 16:49 - Dernière réponse : ptitemeuh
Messages postés
83
Date d'inscription
jeudi 4 février 2010
Dernière intervention
8 juillet 2010
- 11 mai 2010 à 17:16
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 ?
Afficher la suite 

Votre réponse

8 réponses

Meilleure réponse
cs_Le Pivert
Messages postés
5520
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 novembre 2018
- 11 mai 2010 à 15:30
3
Merci
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

Merci cs_Le Pivert 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

Commenter la réponse de cs_Le Pivert
cs_Le Pivert
Messages postés
5520
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 novembre 2018
- 10 mai 2010 à 18:08
0
Merci
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


@+
Commenter la réponse de cs_Le Pivert
cs_Le Pivert
Messages postés
5520
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 novembre 2018
- 10 mai 2010 à 18:31
0
Merci
Rectification


.OnAction = "UserForm_1"

j'avais oublié les quillemets
Commenter la réponse de cs_Le Pivert
ptitemeuh
Messages postés
83
Date d'inscription
jeudi 4 février 2010
Dernière intervention
8 juillet 2010
- 11 mai 2010 à 08:34
0
Merci
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 ?
Commenter la réponse de ptitemeuh
cs_Le Pivert
Messages postés
5520
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 novembre 2018
- 11 mai 2010 à 08:57
0
Merci
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
Commenter la réponse de cs_Le Pivert
ptitemeuh
Messages postés
83
Date d'inscription
jeudi 4 février 2010
Dernière intervention
8 juillet 2010
- 11 mai 2010 à 09:09
0
Merci
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.
Commenter la réponse de ptitemeuh
cs_Le Pivert
Messages postés
5520
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 novembre 2018
- 11 mai 2010 à 09:23
0
Merci
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


@+
Commenter la réponse de cs_Le Pivert
ptitemeuh
Messages postés
83
Date d'inscription
jeudi 4 février 2010
Dernière intervention
8 juillet 2010
- 11 mai 2010 à 17:16
0
Merci
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
Commenter la réponse de ptitemeuh

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.