Sujet Précédent Sujet Suivant

Excel boutons

Fermé
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018 - 2 oct. 2018 à 10:41
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 2 oct. 2018 à 16:49
Bonjour,

J'ai sur ma feuille excel plusieurs boutons correspondant chacun au nom d'une personne. Ces boutons permettent de lancer plusieurs actions (envoi d'u mail, ....). J'aimerai crée un bouton "ajouter une personne" qui lorsque je clique dessus me demande le nom de la personne et crée un bouton qui fasse les mêmes actions que les autres boutons.
Est ce possible?
merci,

A voir également:

10 réponses

Réponse 1 / 10
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 2 oct. 2018 à 11:46
Bonjour,

Oui c'est possible, mais il faut maitriser vba pour écrire la macro qui est affectée au bouton.

Le bouton d'ajout est le CommandButton1 a adapter

Ce mettre sur la feuille concernée, faire Alt F11 pour accéder au module de la feuille et coller ce code: 

Option Explicit
Private Sub CommandButton1_Click()
Ajouter_Bouton
End Sub
Sub Ajouter_Bouton()
Dim NouveauBouton As OLEObject
Dim Code$, NextLine&
Dim i As Integer
Dim Nom As String
Dim Emplacement As Object

'emplacement et nom du bouton
Set Emplacement = Application.InputBox(prompt:="Sélectionner les cellules sur la feuille", Type:=8)
Nom = InputBox("Entrer le nom du bouton :", "Saisie NOM")
Set NouveauBouton = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
   
   'création du bouton
    With NouveauBouton
        .Name = Nom
        .Left = Range(Emplacement.Address).Left
        .Top = Range(Emplacement.Address).Top
        .Width = 100
        .Height = 30
        .Object.Caption = Nom 'à adapter suivant la feuille d'ouverture
    End With

'   Comment ajouter le code se rapportant au bouton...
    Code = "Sub " & Nom & "_Click()" & vbCrLf
    Code = Code & "  On Error Resume Next" & vbCrLf
    Code = Code & "  Sheets(""Feuil3"").Activate" & vbCrLf
    Code = Code & "  If Err <> 0 Then" & vbCrLf
    Code = Code & "   MsgBox ""Impossible d'activer la feuille3.""" & vbCrLf
    Code = Code & "  End If" & vbCrLf
    Code = Code & "End Sub"

'   Ecriture du code dans le module de la feuille (fs)
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
      NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
    End With
End Sub


j'ai mis un code qui active la feuille 3 comme exemple. Si tu n'arrives pas à l'adapter il faudra que tu donnes ton code

Voilà

0
Réponse 2 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 11:51
Ok merci beaucoup je vais tester et je reviens te dire!
0
Réponse 3 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 12:04
Bon je t'avoue que j'ai un peu de mal avec la partie "comment ajouter le code se rapportant au bouton".
Donc voici le code que j'avais deja fait concernant les boutons :

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Option Explicit

Private Sub JeanLuc_Click()
Dim dl As Integer
dl = Sheets("Suivi des colis").Range("a9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("a" & dl) = Format(Now, "MM/DD/YYYY HH:MM")

dl = Sheets("Suivi des colis").Range("b9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("b" & dl) = "Jean-Luc CEBE"

Matériel.Show

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim EMail As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim i
If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)



EMail = "julienlaf2@gmail.com"
' definition du corps du mail "strbody" (sans la signature outlook)


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

strbody = "Bonjour Jean-Luc,</br></br>Nous venons de réceptionner un colis qui t'est destiné.</br></br>Tu peux le récupérer à l'atelier B05.</br></br>Cordialement,"

' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

SigString = Environ("appdata") & _
"\Microsoft\Signatures\mysign.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = "Le responsable Atelier B05"
End If

On Error Resume Next
OutlookMail.Open
With OutlookMail
.Subject = "Réception d'un colis au B05" & _
Format(heure, "hh:mm") & ""
.To = EMail
.htmlbody = strbody & "<br><br>" & Signature


OutlookMail.Send

End With

End Sub


Function OutlookOuvert() As Boolean
Dim oOL As Object
On Error Resume Next
Set oOL = GetObject(, "Outlook.Application")
On Error GoTo 0
OutlookOuvert = Not (oOL Is Nothing)
Set oOL = Nothing
End Function
</code>
0
Réponse 4 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 12:06
Ah oui et ce que je t'ai envoyé n'ai pas le code complet. Tous est refait pour chaque prénom à chaque fois.
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 2 oct. 2018 à 12:28
Voilà le code complet 

Option Explicit
'déclaration des variables
Dim NouveauBouton As OLEObject
Dim Code$, NextLine&
Dim i As Integer
Dim Nom As String
Dim Emplacement As Object

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim EMail As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim dl As Integer
Private Sub CommandButton1_Click()
Ajouter_Bouton
End Sub
Sub Ajouter_Bouton()
'emplacement et nom du bouton
Set Emplacement = Application.InputBox(prompt:="Sélectionner les cellules sur la feuille", Type:=8)
Nom = InputBox("Entrer le nom du bouton :", "Saisie NOM")
Set NouveauBouton = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
   
   'création du bouton
    With NouveauBouton
        .Name = Nom
        .Left = Range(Emplacement.Address).Left
        .Top = Range(Emplacement.Address).Top
        .Width = 100
        .Height = 50
        .Object.Caption = Nom
    End With

'   Comment ajouter le code se rapportant au bouton...
    Code = "Sub " & Nom & "_Click()" & vbCrLf
    Code = Code & "  On Error Resume Next" & vbCrLf
    Code = Code & "  envoimail" & vbCrLf
    Code = Code & "  If Err <> 0 Then" & vbCrLf
    Code = Code & "   MsgBox ""Impossible d'envoyer le mail.""" & vbCrLf
    Code = Code & "  End If" & vbCrLf
    Code = Code & "End Sub"

'   Ecriture du code dans le module de la feuille (fs)
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
      NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
    End With
End Sub
Sub envoimail()

dl = Sheets("Suivi des colis").Range("a9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("a" & dl) = Format(Now, "MM/DD/YYYY HH:MM")

dl = Sheets("Suivi des colis").Range("b9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("b" & dl) = Nom  'j'ai changer JeanLuc par la variable Nom, a toi de voir???

Matériel.Show

EMail = "julienlaf2@gmail.com"
' definition du corps du mail "strbody" (sans la signature outlook)


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

strbody = "Bonjour " & Nom & ",</br></br>Nous venons de réceptionner un colis qui t'est destiné.</br></br>Tu peux le récupérer à l'atelier B05.</br></br>Cordialement," 'j'ai changer JeanLuc par la variable Nom, a toi de voir???

' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

SigString = Environ("appdata") & _
"\Microsoft\Signatures\mysign.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = "Le responsable Atelier B05"
End If

On Error Resume Next
OutlookMail.Open
With OutlookMail
.Subject = "Réception d'un colis au B05" & _
Format(heure, "hh:mm") & ""
.To = EMail
.htmlbody = strbody & "<br><br>" & Signature


OutlookMail.Send

End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Function OutlookOuvert() As Boolean
Dim oOL As Object
On Error Resume Next
Set oOL = GetObject(, "Outlook.Application")
On Error GoTo 0
OutlookOuvert = Not (oOL Is Nothing)
Set oOL = Nothing
End Function


@+ Le Pivert
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 12:43
il me dit nom ambigue detecte : getboiler
0
Réponse 6 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 12:56
Et incompatibilité de type à ce niveau :

Set Emplacement = Application.InputBox(prompt:="Sélectionner les cellules sur la feuille", Type:=8)
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 13:40
aucun problème chez moi, si ce n'est que le mail ne part pas par manque d’élément. Pas de bug:

https://www.cjoint.com/c/HJclMEKZx2Q

Voilà

@+
0
Réponse 7 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 14:00
Merci mais en fait, quand je rentre le nouveau prénom et que je valide, il me marque erreur d’exécution 1004 : l’accès par programme au projet Visual Basic n'est pas fiable.
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 14:16
Je ne vois pas pourquoi tu t'embêtes avec un bouton par personne pour utiliser la même macro avec le nom qui diffère!
Utilise une Inputbox avec ta variable Nom comme je l'ai fait, Tu mets ta ligne de code comme ceci : 

Sub envoimail()
Dim Nom As String
Nom = InputBox("Entrer le nom :", "Saisie NOM")


et le tour est joué!
Un seul bouton

Voilà
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 14:28
Pour le nom, il ne faut pas de nom composé avec trait d'union ou d'espace. Car c'est ce nom qui est donné au bouton!!!

si tu veux quand même mettre un bouton par personne, il faudra changer ce code: 

'   Comment ajouter le code se rapportant au bouton...
    Code = "Sub " & Nom & "_Click()" & vbCrLf
    Code = Code & "  Nom = " & Nom & ".Caption" & vbCrLf 'ajout de cette ligne pour avoir le nom
    Code = Code & "  On Error Resume Next" & vbCrLf
    Code = Code & "  envoimail" & vbCrLf
    Code = Code & "  If Err <> 0 Then" & vbCrLf
    Code = Code & "   MsgBox ""Impossible d'envoyer le mail.""" & vbCrLf
    Code = Code & "  End If" & vbCrLf
    Code = Code & "End Sub"


Voilà
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 14:34
Pour cela:

l’accès par programme au projet Visual Basic n'est pas fiable.

Va dans le Ruban: Developpeur; Sécurité des Macros et cocher:

accès approuvé au modèle d'objet du projet VBA

@+
0
Réponse 8 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 14:32
Merci beaucoup mais après qaund mon bouton est crée il n'arrive pas reproduire les mêmes actions que les autres boutons il ne se passe rien quand j'appuie.
Dsl je ne suis pas très bon...
0
Réponse 9 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 14:40
ah merci ça marche mais une autre erreur apparaît, cette fois c'est l'erreur d’exécution 9 : l'indice n’appartient pas à la sélection
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 15:23
qu'elle est la ligne surlignée en jaune?
quand tu passes le curseur sur toute la ligne, qu'indique-t-il?
0
Réponse 10 / 10
Jul997 Messages postés 11 Date d'inscription mercredi 19 septembre 2018 Statut Membre Dernière intervention 2 octobre 2018
2 oct. 2018 à 15:29
je n'ai malheureusement aucune ligne surlignée en jaune...
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 oct. 2018 à 15:45
Il faut que tu cherches par toi même où cela se produit avec la méthode Pas à pas:

https://excel.quebec/excel-programmation-vba/vba-mode-pas-pas/
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 2 oct. 2018 à 17:14
Voilà le code opérationnel! 


Option Explicit
'allez dans outils, Référence et  cochez la référence Microsoft Outlook 12.0 object library
'déclaration des variables
Dim NouveauBouton As OLEObject
Dim Code$, NextLine&
Dim i As Integer
Dim Nom As String
Dim Emplacement As Object

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim EMail As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim dl As Integer

Private Sub CommandButton1_Click()
Ajouter_Bouton
End Sub
Sub Ajouter_Bouton()
'emplacement et nom du bouton
Set Emplacement = Application.InputBox(prompt:="Sélectionner les cellules sur la feuille", Type:=8)
Nom = InputBox("Entrer le nom du bouton :", "Saisie NOM")
Set NouveauBouton = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
   
   'création du bouton
    With NouveauBouton
        .Name = Nom
        .Left = Range(Emplacement.Address).Left
        .Top = Range(Emplacement.Address).Top
        .Width = 100
        .Height = 50
        .Object.Caption = Nom
    End With

'   Comment ajouter le code se rapportant au bouton...
    Code = "Sub " & Nom & "_Click()" & vbCrLf
    Code = Code & "  Nom = " & Nom & ".Caption" & vbCrLf
    Code = Code & "  On Error Resume Next" & vbCrLf
    Code = Code & "  envoimail" & vbCrLf
    Code = Code & "  If Err <> 0 Then" & vbCrLf
    Code = Code & "   MsgBox ""Impossible d'envoyer le mail.""" & vbCrLf
    Code = Code & "  End If" & vbCrLf
    Code = Code & "End Sub"

'   Ecriture du code dans le module de la feuille (fs)
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
      NextLine = .CountOfLines + 1
      .InsertLines NextLine, Code
    End With
End Sub
Sub envoimail()
dl = Sheets("Suivi des colis").Range("a9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("a" & dl) = Format(Now, "MM/DD/YYYY HH:MM")

dl = Sheets("Suivi des colis").Range("b9999").End(xlUp).Row + 1
Sheets("Suivi des colis").Range("b" & dl) = Nom

Matériel.Show

EMail = "julienlaf2@gmail.com"
' definition du corps du mail "strbody" (sans la signature outlook)


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

strbody = "Bonjour " & Nom & ",</br></br>Nous venons de réceptionner un colis qui t'est destiné.</br></br>Tu peux le récupérer à l'atelier B05.</br></br>Cordialement," 'j'ai changer JeanLuc par la variable Nom, a toi de voir???

' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

SigString = Environ("appdata") & _
"\Microsoft\Signatures\mysign.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = "Le responsable Atelier B05"
End If

On Error Resume Next
 With OutlookMail
        .Display
        .To = EMail
        .CC = ""
        .BCC = ""
        .Subject = "Réception d'un colis au B05" & _
Format(Now, "hh:mm") & ""
        .HTMLBody = strbody & "<br><br>" & Signature
        .Send
    End With
     MsgBox "Mail envoyé."
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Function OutlookOuvert() As Boolean
Dim oOL As Object
On Error Resume Next
Set oOL = GetObject(, "Outlook.Application")
On Error GoTo 0
OutlookOuvert = Not (oOL Is Nothing)
Set oOL = Nothing
End Function


@+ Le Pivert
0