XL 2016 Mettre du texte dans un mail automatisé depuis Excel sans que la capture l'efface.

L

Loc3007

XLDnaute Nouveau
Bonjour,

J'ai crée un fichier de recensement, avec une macro qui fait une capture d'écran et qui l'envoi dans 2 mails distinct.
Mon souci, quand les mails sont créés, il efface le texte-:
(Bonjour,

Vous trouverez ci dessous les données...).

Si vous pouvez modifier ce fichier, j'en serais ravi.

En vous remerciant.

Cordialement
 

Pièces jointes

  • Copie de recensement2 VBA 2023.xlsm
    23.5 KB · Affichages: 3
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
De rien,
Si vous voulez une version simplifiée et condensée :
VB: 
Sub Envoi_Email()
    
    Mailto Join(WorksheetFunction.Transpose(Sheets("mails").[A3:A10]), ";")
 '   Mailto Join(WorksheetFunction.Transpose(Sheets("mails").[E2:E8]), ";")
    
End Sub
Sub Mailto(Dest, Optional CC = "")
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Destinataires
        If CC <> "" Then .CC = CC
        .Subject = "Bilan des grévistes"
        .Display ' pour pouvoir exploiter le wordeditor
        Sig = .body ' Pour récupérer la signature éventuelle
        .body = ""
        With .GetInspector.WordEditor
            .Content.InsertBefore _
                "Bonjour, " & vbLf & _
                "Vous trouverez ci-dessous l'état récapitulatif des agents déclarés grévistes ce jour." & vbLf
            
            .Content.InsertParagraphAfter
             Sheets("Bilan grévistes").Range("A1:B61").CopyPicture
            .Paragraphs(4).Range.Paste
            
            .Content.InsertParagraphAfter
            .Content.InsertAfter vbLf & "Cordialement,"
            .Content.InsertAfter Sig
        End With
    End With
End Sub
 
Vote positif 0 Vote négatif
L

Loc3007

XLDnaute Nouveau
Bonjour franch 55,

Merci, pour ces améliorations, j'ai encore un petit souci, avec le code ci-dessous, il génère 2 mails, concernant le 1er pas de soucis (il y a bien les destinataire entre A5 àA10 et les destinataires en copie de B5 à B10 de l'onglet mails), par contre pour le 2nd mail, il me mets en destinataire principale de la liste B de l'onglet mails, et non de la colonne E (de E5 à E10).
Avez-vous une solution ? aussi si vous pouvez ajouter le paver de signature comme dans votre dernière réponse ?

En vous remerciant, cordialement.

Sub Envoi_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim Destinataire1 As String ' <-- Ajout de la déclaration
Dim Destinataire2 As String
Dim Capture As Range

Destinataire1 = ""
For i = 2 To 10
Destinataire1 = Destinataire1 & Sheets("mails").Range("A" & i).Value & ";"
Next i
Destinataire1 = Left(Destinataire1, Len(Destinataire1) - 1)

'Définition des destinataires de la deuxième liste (en copie)
Destinataire2 = ""
For i = 2 To 10
Destinataire2 = Destinataire2 & Sheets("mails").Range("B" & i).Value & ";"
Next i
Destinataire2 = Left(Destinataire2, Len(Destinataire2) - 1)

'Création du texte de l'email
Dim Texte As String
Texte = "Bonjour," & vbCrLf & vbCrLf & "Vous trouverez ci-dessous l'état récapitulatif des agents déclarés grévistes ce jour. "

'Copie de la capture d'écran
Set Capture = Sheets("Bilan grévistes").Range("A1:B61")
Capture.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Création du brouillon de premier email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Destinataire1 ' Ajout des destinataires principaux
.CC = Destinataire2 ' Ajout des destinataires en copie
.Subject = "Bilan des grévistes"
.Body = Texte
.Display
Set wdDoc = .GetInspector.WordEditor
wdDoc.Content.InsertParagraphAfter
wdDoc.Content.InsertParagraphAfter
wdDoc.Paragraphs(3).Range.Paste
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter vbCrLf & "Cordialement,"
End With

Set OutMail = Nothing
Set OutMail = OutApp.CreateItem(0)
'Création du brouillon de deuxième email
With OutMail
.To = Destinataire2 ' Ajout des destinataires en copie
.Subject = "Bilan des grévistes"
.Body = Texte
.Display
Set wdDoc = .GetInspector.WordEditor
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter " "
wdDoc.Range(0, wdDoc.Characters.Count).InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter vbCrLf & "Cordialement,"
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
 
Vote positif 0 Vote négatif
L

Loc3007

XLDnaute Nouveau
Re bonjour,

Je viens de trouver, il manque que l'insertion du pavé de signature.

Sub Envoi_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim Destinataire1 As String
Dim Destinataire2 As String
Dim Destinataire3 As String
Dim Capture As Range

Destinataire1 = ""
For i = 5 To 10
Destinataire1 = Destinataire1 & Sheets("mails").Range("A" & i).Value & ";"
Next i
Destinataire1 = Left(Destinataire1, Len(Destinataire1) - 1)

Destinataire2 = ""
For i = 5 To 10
Destinataire2 = Destinataire2 & Sheets("mails").Range("B" & i).Value & ";"
Next i
Destinataire2 = Left(Destinataire2, Len(Destinataire2) - 1)

Destinataire3 = ""
For i = 5 To 10
Destinataire3 = Destinataire3 & Sheets("mails").Range("E" & i).Value & ";"
Next i
Destinataire3 = Left(Destinataire3, Len(Destinataire3) - 1)

Dim Texte As String
Texte = "Bonjour," & vbCrLf & vbCrLf & "Vous trouverez ci-dessous l'état récapitulatif des agents déclarés grévistes ce jour. "

Set Capture = Sheets("Bilan grévistes").Range("A1:B61")
Capture.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Destinataire1
.CC = Destinataire2
.Subject = "Bilan des grévistes"
.Body = Texte
.Display
Set wdDoc = .GetInspector.WordEditor
wdDoc.Content.InsertParagraphAfter
wdDoc.Content.InsertParagraphAfter
wdDoc.Paragraphs(3).Range.Paste
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter vbCrLf & "Cordialement,"
End With

Set OutMail = Nothing
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Destinataire3
.Subject = "Bilan des grévistes"
.Body = Texte
.Display
Set wdDoc = .GetInspector.WordEditor
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter " "
wdDoc.Range(0, wdDoc.Characters.Count).InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
wdDoc.Range(0, wdDoc.Characters.Count).InsertAfter vbCrLf & "Cordialement,"
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub


Merci

Cordialement
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Le code suivant fait ce que vous décrivez en dernier .
Cela n'a plus de lien avec le classeur que vous avez fourni ..
VB: 
Sub Envoi_Email()
    
    Mailto Dest:=Join(WorksheetFunction.Transpose(Sheets("mails").[A5:A10]), ";"), _
             CC:=Join(WorksheetFunction.Transpose(Sheets("mails").[B5:B10]), ";")

   Mailto Dest:=Join(WorksheetFunction.Transpose(Sheets("mails").[E5:E10]), ";")
    
End Sub
Sub Mailto(Dest, Optional CC = "")
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Destinataires
        If CC <> "" Then .CC = CC
        .Subject = "Bilan des grévistes"
        .Display ' pour pouvoir exploiter le wordeditor
        Sig = .body ' Pour récupérer la signature éventuelle
        .body = ""
        With .GetInspector.WordEditor
            .Content.InsertBefore _
                "Bonjour, " & vbLf & _
                "Vous trouverez ci-dessous l'état récapitulatif des agents déclarés grévistes ce jour." & vbLf
            
            .Content.InsertParagraphAfter
             Sheets("Bilan grévistes").Range("A1:B61").CopyPicture
            .Paragraphs(4).Range.Paste
            
            .Content.InsertParagraphAfter
            .Content.InsertAfter vbLf & "Cordialement,"
            .Content.InsertAfter Sig
        End With
    End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Résolu(e)
XL 2016 Besoin d'ajouter une fonctionnalité d'envoi d'e-mails pour deux personnes dans un outil 5S
2
Réponses
15
Affichages
663
Pauuul35
P
S
  • Question
Microsoft 365 Combobox Active X : impossible de visualiser le texte que l'on écrit dans la partie texte quand l'échelle de l'écran est à 125% dans windows
Réponses
4
Affichages
337
sansanruru
S
laurent950
  • Question
XL 2016 Depuis un Module Standard pouvoir Récupérer la Photocopie d'une Classe (dont/Avec) la collection qui est incluse dans le Module de Classe.
6 7 8
Réponses
115
Affichages
4 K
laurent950
laurent950
A
  • Question
XL 2016 Lenteur de saisie de texte dans un tableau Excel
Réponses
7
Affichages
439
Deadpool_CC
Deadpool_CC
C
  • Résolu(e)
XL 2019 Créer un mail avec liste de contact dans colonne excel avec Objet et corps de texte
2 3
Réponses
33
Affichages
4 K
cytise95
C
J
  • Question
Excel -VBA : Envoie plusieurs partie du même tableau dans un corps mail en fonction de certaines conditions
Réponses
0
Affichages
1 K
JBIK
J
H
  • Question
Autres Générer un mail depuis Excel à travers une VBA
Réponses
13
Affichages
3 K
Staple1600
Staple1600
A
  • Question
Microsoft 365 Modifier la couleur du texte dans un mail généré par excel
Réponses
2
Affichages
607
AIr-V
A
Z
  • Question
XL 2019 (VBA) AutoFiltre de valeurs dans un intervalle
Réponses
3
Affichages
1 K
Zort.x
Z
A
  • Question
Outlook Enregistrer les pièces jointes de nombreux e-mails à la fois dans Outlook?
Réponses
4
Affichages
2 K
Anthony_51
A

Membres actuellement en ligne

6 membres et 44 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 182
dernier inscrit
moutassim.amine