[excel 2003] envoi email auto - ajouter corps de message

Profane

XLDnaute Occasionnel
Bonjour a tous,
tous est dans le titre

voici la macro qui fonctionne MAIS j'ignore complétement comment ajouter un corps de texte....

********************************************
Private Sub CommandButton1_Click()

Dim Dest As String, Sujet As String
Sheets("Template").Select
ActiveSheet.Copy
Dest = "toto@orange.fr"
Sujet = "test"
ActiveWorkbook.SendMail Dest, Sujet, True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

End Sub
************************************

merci a tous pour votre aide

@+
 
C

Compte Supprimé 979

Guest
Re : [excel 2003] envoi email auto - ajouter corps de message

Re,

Désolé, je n'avais pas testé :eek: il y avait une grosse horreur :)
Les CheckBox n'étaient pas testés correctement

Essaye avec ce code
VB:
Sub Envoi_mail()
 Dim Inc As Integer, i&, sNomFic As String, sNoms As String
 Dim Obj As Object
  Dim Ol As Object, Olmail As MailItem, ListeTo As String, liste As String
  
  Application.ScreenUpdating = False
  sNomFic = ThisWorkbook.FullName  ' pour envoyer le classeur actif


  With Feuil1
    If .CheckBox1.Value = True Then sNoms = .Range("N4").Value
    For Each Obj In .OLEObjects
      If Left(Obj.Name, 5) = "Check" And Obj.Name <> "CheckBox1" Then
      ' Récupérer le numéro du checkbox
        Inc = Right(Obj.Name, Len(Obj.Name) - InStr(1, Obj.Name, "x"))
        If Obj.Object.Value = True Then sNoms = sNoms & " " & .Cells(4, 14 + ((Inc - 2) * 2)).Value
      End If
    Next Obj
  End With


  Set Ol = New Outlook.Application
  Set Olmail = Ol.CreateItem(olMailItem)


  For i = 6 To Feuil1.Range("j65536").End(xlUp).Row
    If Cells(i, 10).Value = "" Then ListeTo = ListeTo & Cells(i, 11).Value
    If Cells(i, 10).Value = "X" Then liste = liste & Cells(i, 11).Value & ";"
  Next i


  With Olmail
    .To = ListeTo
    .BCC = liste
    .Subject = "Message de Jacky"
    .Body = " Bonjour," & vbCrLf & " Voici le fichier de pré-Inscription pour " & sNoms _
    & vbCrLf & " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
    .Attachments.Add sNomFic
    .Display
  End With
End Sub

A+
 

Lone-wolf

XLDnaute Barbatruc
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonjour à tous,

@ jacky: voici la modification des codes pour le choix des destinataires.


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("h5:h65536")) Is Nothing Then Range("h5:h65536").ClearContents
If Not Intersect(Target, Range("k6:k100")) Is Nothing Then
    For j = 6 To Feuil1.Range("k65536").End(xlUp).Row
    If Target.Offset <> "" Then Target.Offset(j, -1).Value = "c" 
    Next j
End If
End Sub

Code:
 For i = 6 To Feuil1.Range("j65536").End(xlUp).Row
    If Cells(i, 10).Value = "c" Then ListeTo = ListeTo & Cells(i, 11).Value & ";"
    If Cells(i, 10).Value = "x" Then Liste = Liste & Cells(i, 11).Value & ";"
    Next i

Pour l'envois d'un seul destinataire: Case à cocher désactivée - sélectionner sur l'adresse.

Pour l'envois avec choix du 1er destinataire et les autres en Cci:
Case à cocher activée - sélectionner l'adresse.


A+ :cool:
 
Dernière édition:

Paritec

XLDnaute Barbatruc
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonjour Jacky Bruno,
oui j'avais codé pour un userform
voilà rectifié
a+
Papou:eek:

Code:
Sub test()    
     With Feuil1
        col = 14
        For i = 1 To 36 ' enfin si tu as bien 36 checkbox
            If .OLEObjects("CheckBox" & i).Object Then
                List = List & " " & .Cells(4, col)
            End If
            col = col + 2
          If i = 1 Then i = 2
        Next i
    End With  
    'et là dans ton email tu remplaces le .body par le ci-dessous
.Body = " Bonjour," & vbCrLf & " Voici le fichier de pré-Inscription pour " & " " & List & " " & vbCrLf _
& " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
End Sub
 

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonsoir le forum,Bruno ; Lone Wolf et Paritec,

Le code de bRuno fonctionne impeccable et Paritec sur le tien il me met, erreur de compilation: Référence incorrecte ou non qualifié et il me surligne en jaune .Body
Lone Wolf, je teste et te redis
merci a vous
jacky
 

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Re,
Lone-Wolf, c ok ca fonctionne, Bruno, dans ton code, quand je cose les courses mais pas la 1ère donc la checbox 1, il me la met quand même et quand je la coche, du coup il me la met 2 fois
merci
jacky
 

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonsoir le forum,Bruno, Paritec,

Que faut il changer dans le code pour qu'il tienne compte des colonnes que j'ai insérer après chaque course, je m'explique, j'avais un bouton à cocher (Checkbox ) toute les 2 colonnes, maintenant ce serait toute les 3 colonnes
Code:
Sub Envoi_mail()
 Dim Inc As Integer, i&, sNomFic As String, sNoms As String
 Dim Obj As Object
  Dim Ol As Object, Olmail As MailItem, ListeTo As String, liste As String
 
  Application.ScreenUpdating = False
  sNomFic = ThisWorkbook.FullName  ' pour envoyer le classeur actif


  With Feuil1
    If .CheckBox1.Value = True Then sNoms = .Range("N4").Value
    For Each Obj In .OLEObjects
      If Left(Obj.Name, 5) = "Check" And Obj.Name <> "CheckBox1" Then
      ' Récupérer le numéro du checkbox
       Inc = Right(Obj.Name, Len(Obj.Name) - InStr(1, Obj.Name, "x"))
        If Obj.Object.Value = True Then sNoms = sNoms & " " & .Cells(4, 14 + ((Inc - 2) * 2)).Value
      End If
    Next Obj
  End With


  Set Ol = New Outlook.Application
  Set Olmail = Ol.CreateItem(olMailItem)


  For i = 6 To Feuil1.Range("j65536").End(xlUp).Row
    If Cells(i, 10).Value = "" Then ListeTo = ListeTo & Cells(i, 11).Value
    If Cells(i, 10).Value = "X" Then liste = liste & Cells(i, 11).Value & ";"
  Next i


  With Olmail
    .To = ListeTo
    .BCC = liste
    .Subject = "Message de Jacky"
    .Body = " Bonjour," & vbCrLf & " Voici le fichier de pré-Inscription pour " & sNoms _
    & vbCrLf & " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
    .Attachments.Add sNomFic
    .Display
  End With
End Sub
merci
jacky
 
C

Compte Supprimé 979

Guest
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonsoir Jacky49

Normalement, il suffit de changer le "* 2" par "* 3" de la ligne
Code:
 If Obj.Object.Value = True Then sNoms = sNoms & " " & .Cells(4, 14 + ((Inc - 2) * 2)).Value

A+
 

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Re Bruno,

Oui, cela fonctionne, j'avais changer aussi le - 2 et c'est donc pour cela que cela ne fonctionnait pas mais par contre, pourquoi lorsque je ne coche pas la checkbox 1, il me la met quand même dans le mail
merci
jacky
 

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Re le forum,Bruno

le problème , c'est que mon fichier comporte 36 checkbox mais il est trop lourd mais admettons que je change la checbox 1 en checkbox et vice versa, cela voudrait dire que l'on commence à la checbox 2 jusqu'a la 36 pour choisir les courses donc le code pourrait peut-être être simplifier, autrement le fichier est le même que celui que j'ai déja envoyer sauf qu'il manque des checkbox pour alléger le fichier
merci jacky
Edit: je renvoie le fichier tel qu'il est conçu , j'ai enlevé les données confidentiels, donc le principe, je coche la case destiné à sélectionner les destinataires du message et je coche chaque case pour sélectionnées les courses qui doivent apparaitre dans le message
merci
jacky
 

Pièces jointes

  • Essai Checkbox.zip
    66.1 KB · Affichages: 33
  • Essai Checkbox.zip
    66.1 KB · Affichages: 35
  • Essai Checkbox.zip
    66.1 KB · Affichages: 36
Dernière édition:

jacky49

XLDnaute Impliqué
Re : [excel 2003] envoi email auto - ajouter corps de message

Bonjour le forum, Bruno,

je remets le fichier sans le mot de passe et avec mes excuses
jacky
 

Pièces jointes

  • Essai Checkbox.zip
    59.5 KB · Affichages: 57
  • Essai Checkbox.zip
    59.5 KB · Affichages: 51
  • Essai Checkbox.zip
    59.5 KB · Affichages: 55
C

Compte Supprimé 979

Guest
Re : [excel 2003] envoi email auto - ajouter corps de message

Re,

Essaye avec ceci, il faut également tester si l'objet n'est pas le Checkbox2 :eek: (puisque non utilisé)
Sinon l'incrément récupéré : Inc=2
La colonne est donc : 14 + ((Inc - 2) * 3) = 14, soit la colonne N

VB:
Sub Envoi_mail()
  Dim Inc As Integer, i&, sNomFic As String, sNoms As String
  Dim Obj As Object
  Dim Ol As Object, Olmail As MailItem, ListeTo As String, liste As String


  Application.ScreenUpdating = False
  sNomFic = ThisWorkbook.FullName  ' pour envoyer le classeur actif


  With Feuil1
    If .CheckBox1.Value = True Then sNoms = .Range("N4").Value
    ' Pour chaque objet de la feuille
    For Each Obj In .OLEObjects
      ' Si le nom de l'objet commence par Check et que ce n'est pas le premier
      If Left(Obj.Name, 5) = "Check" And Obj.Name <> "CheckBox1" And Obj.Name <> "CheckBox2" Then
        ' Récupérer le numéro du checkbox
        Inc = Right(Obj.Name, Len(Obj.Name) - InStr(1, Obj.Name, "x"))
        If Obj.Object.Value = True Then sNoms = sNoms & " " & .Cells(4, 14 + ((Inc - 2) * 3)).Value
      End If
    Next Obj
  End With


  Set Ol = New Outlook.Application
  Set Olmail = Ol.CreateItem(olMailItem)


  For i = 6 To Feuil1.Range("j65536").End(xlUp).Row
    If Cells(i, 10).Value = "" Then ListeTo = ListeTo & Cells(i, 11).Value
    If Cells(i, 10).Value = "X" Then liste = liste & Cells(i, 11).Value & ";"
  Next i


  With Olmail
    .To = ListeTo
    .BCC = liste
    .Subject = "Message de Jacky"
    .Body = " Bonjour," & vbCrLf & " Voici le fichier de pré-Inscription pour " & sNoms _
          & vbCrLf & " à remplir et à me renvoyer " & vbCrLf & " Sportivement " & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
    .Attachments.Add sNomFic
    .Display
  End With
End Sub
Sub Envoi_mail1()
    Dim Ol As New Outlook.Application, Olmail As MailItem, CurrFile$, nom$, dest$, fin&, i&, a&, liste$, n&
    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    Application.ScreenUpdating = False
    'nom = ThisWorkbook.FullName ' si un jour Jacky tu veux envoyer le fichier avec
    With Feuil1
        fin = Feuil1.Range("I" & Rows.Count).End(xlUp).Row
        For i = 5 To fin
            If .Cells(i, 12) <> "" Then dest = dest & .Cells(i, 13) & ";"
        Next i
    If dest = "" Then MsgBox "Vous n'avez choisi aucune Adresse", , "Pas de destinataire":  Exit Sub
        dest = Mid(dest, 1, Len(dest) - 1)
    End With
    With Olmail
        .To = dest
        .CC = liste
        .Subject = "Message de Jacky"
        .Body = "Bonjour," & vbCrLf & " @ Bientôt " & vbCrLf & " Jacky "
        '.Attachments.Add nom 'Jacky si un jour tu modifies pour envoyer un fichier tu retires le ' en début de ligne
        .Display
    End With
End Sub

Ca à l'air de fonctionner ;)

A+
 
Dernière modification par un modérateur:

Discussions similaires

Réponses
2
Affichages
118

Statistiques des forums

Discussions
312 231
Messages
2 086 430
Membres
103 207
dernier inscrit
Michel67