Envoyer un mail avec outlook à partir d'excel avec des tableaux dans le corps du mail

**BarneyYagami** · 07/11/2014, 09h42

Hello tout le monde !

J'ai un petit soucis sur une macro qui doit faire un lien entre excel et outlook et je voulais savoir si vous pouviez m'aider étant novice dans ce langage

J'ai un fichier en PJ, contenant plusieurs onglets (Tableau 1, Tableau 2, Tableau 3, Paramètres)

Je dois faire une macro qui afficherait un mail outlook et qui prendrait en corps de texte les cellules E26 - E27 et E28 et insérerait les tableaux correspondant dans le texte (la longueur des tableaux est variable).

Mon mail s'afficherait comme ceci :

"Voici le tableau 1:
[on collera ici le tableau de l'onglet Tableau1]

Voici le tableau 2:
[on collera ici le tableau de l'onglet Tableau2]

Voici le tableau 3:
[on collera ici le tableau de l'onglet Tableau3]"

Le problème est qu'il faudrait que je prennent 3 tableaux dans 3 onglets différents en paramètre.

Pouvez-vous m'aider ?

Voici le code que j'ai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub EnvoyerMail()
    MailOutlook activesheet.Range("B2"), activesheet.Range("B3"), activesheet.Range("B4")
End Sub
 
Sub MailOutlook(mailCP As String, objet As String, body As String)
' VARIABLES
' mailOutlook : Adresse email du destinataire
' objet : Objet de l'email
' body : Message de l'email
 
'Avant de lancer cette macro, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
'Il est possible de vérifier avant l'exécution de la macro si la référence est activée ou non, et de l'activer si ce n'est pas le cas
 
Dim Ol As New Outlook.Application
Dim Olmail As MailItem
 
    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    With Olmail
        .Subject = objet
        .body = body
 
        .To = mailCP
        .Display
        ' On attend 1 seconde afin d'être sûr qu'Outlook soit bien lancé (en fonction de la rapidité de l'ordinateur utilisé)
       Attendre 1
        ' On se place à la fin du message
       SendKeys "{PGDN}", True
        ' On insère la signature
       SendKeys "{ENTER}", True
        SendKeys "%S", True
        SendKeys "S", True
        SendKeys "E", True
        SendKeys "{ENTER}", True
    End With
End Sub
 
Sub Attendre(Secondes As Integer)
' Cette procédure temporise pendant le nombre de secondes qu'on lui transmet en argument
Dim Début As Long, fin As Long, Chrono As Long
Début = Timer
fin = Début + Secondes
Do Until Timer >= fin
    DoEvents
Loop
End Sub

En vous remerciant d'avance pour votre aide.

Cordialement,
BY

**BarneyYagami** · 13/11/2014, 18h04

Bonsoir,

Je me permets de relancer le sujet en l'absence de réponse.

J'ai modifié le code de la manière suivante mais cela ne fonctionne toujours pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
Option Explicit
Sub MailOutlook(mailCP As String, mailcc As String, objet As String, body As String)
 
' VARIABLES
' mailOutlook : Adresse email du destinataire
' objet : Objet de l'email
' body : Message de l'email
 
'AVANT DE LANCER CETTE MACRO, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
'Il est possible de vérifier avant l'exécution de la macro si la référence est activée ou non, et de l'activer si ce n'est pas le cas
 
Dim ol As New Outlook.Application
Dim Olmail As MailItem
Dim Texte As String
Dim onglet As String
Dim plagetableau As String
Dim fin As Long
Dim marche As Integer
 
'Texte = Sheets("Devis passant en CEC").Range("B2:B6")
'Texte = Join(Application.Transpose(Sheets("Devis passant en CEC").Range("B2:B6").Value), vbLf)
 
For marche = 16 To 21
 
    Sheets("Paramètres").Select
    If IsEmpty(Cells(marche, "C")) = False Then
 
        mailCP = Sheets("Paramètres").Cells(marche, "E").Value
        mailcc = Sheets("Paramètres").Cells(marche, "G").Value
    Sheets(UserForm1.getOnglet).Select
    Range(UserForm1.getplagetableau).Select
        Selection.AutoFilter
        ActiveSheet.Range("$B$2:$I" & UserForm1.getfin).AutoFilter Field:=1, Criteria1:=Sheets("Paramètres").Cells(marche, 3).Value
        'ActiveSheet.Range("$B$2:$I" & fin).AutoFilter Field:=1, Criteria1:=Sheets("Paramètres").Cells(marche, 3).Value
        Selection.Copy
 
    Set ol = New Outlook.Application
    Set Olmail = ol.CreateItem(olMailItem)
    With Olmail
        .Subject = objet & Sheets("Paramètres").Cells(marche, "C").Value
       ' .body = UserForm1.getbody & vbCrLf & vbCrLf & Selection.Paste '& vbCrLf & Texte
        .body = UserForm1.getbody & vbCrLf & vbCrLf '& Selection.Paste '& vbCrLf & Texte
        .To = mailCP
        .cc = mailcc
        .Display
' On attend 1 seconde afin d'être sûr qu'Outlook soit bien lancé (en fonction de la rapidité de l'ordinateur utilisé)
         Attendre 1
' On se place à la fin du message
        SendKeys "{PGDN}", True
' On insère la signature
        SendKeys "{ENTER}", True
        SendKeys "%S", True
        SendKeys "S", True
        SendKeys "E", True
        SendKeys "{ENTER}", True
 
    End With
    End If
 
    Sheets(UserForm1.getOnglet).Select
    Range(UserForm1.getplagetableau).Select
    ActiveSheet.ShowAllData
 
Next marche
 
End Sub
 
Sub Attendre(Secondes As Integer)
' Cette procédure temporise pendant le nombre de secondes qu'on lui transmet en argument
Dim Début As Long, fin As Long, Chrono As Long
Début = Timer
fin = Début + Secondes
Do Until Timer >= fin
    DoEvents
Loop
End Sub
 
Sub EnvoyerMail()
 
Load UserForm1
UserForm1.Show
 
'Call MailOutlook
'MailOutlook ActiveSheet.Range("E16"), ActiveSheet.Range("G16"), ActiveSheet.Range("C7"), ActiveSheet.Range("E25")
End Sub

Userform1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
 
Dim onglet As String
Dim onglet1 As String
Dim onglet2 As String
Dim onglet3 As String
Dim plagetableau As String
Dim plagetableau1 As String
Dim plagetableau2 As String
Dim plagetableau3 As String
Dim fin As Integer
Dim fin1 As Integer
Dim fin2 As Integer
Dim fin3 As Integer
Dim body As String
Dim body1 As String
Dim body2 As String
Dim body3 As String
Function getOnglet() As String
    getOnglet = onglet
End Function
Function getOnglet1() As String
    getOnglet1 = onglet1
End Function
Function getOnglet2() As String
    getOnglet2 = onglet2
End Function
Function getOnglet3() As String
    getOnglet3 = onglet3
End Function
Function getplagetableau() As String
    getplagetableau = plagetableau
End Function
Function getplagetableau1() As String
    getplagetableau1 = plagetableau1
End Function
Function getplagetableau2() As String
    getplagetableau2 = plagetableau2
End Function
Function getplagetableau3() As String
    getplagetableau3 = plagetableau3
End Function
Function getfin() As String
    getfin = fin
End Function
Function getfin1() As String
    getfin1 = fin1
End Function
Function getfin2() As String
    getfin2 = fin2
End Function
Function getfin3() As String
    getfin3 = fin3
End Function
Function getbody() As String
    getbody = body
End Function
Function getbody1() As String
    getbody1 = body1
End Function
Function getbody2() As String
    getbody2 = body2
End Function
Function getbody3() As String
    getbody3 = body3
End Function
Private Sub CheckBox1_Click()
'en anomalie
 
If CheckBox1.Value = True Then
 
    objet = Sheets("Paramètres").Cells(26, 4).Value '"D26"
 
    onglet1 = "Devis date passée"
    onglet2 = "Devis avec date non formalisée"
    onglet3 = "Devis sans date CEC"
 
    body1 = Sheets("Paramètres").Cells(26, 5).Value '"E26"
    body2 = Sheets("Paramètres").Cells(27, 5).Value '"E27"
    body3 = Sheets("Paramètres").Cells(28, 5).Value '"E28"
 
    fin1 = Sheets("Devis date passée").Range("B2").End(xlDown).Row
    fin2 = Sheets("Devis avec date non formalisée").Range("B2").End(xlDown).Row
    fin3 = Sheets("Devis sans date CEC").Range("B2").End(xlDown).Row
 
    Sheets("Devis date passée").Select
    plagetableau1 = "B2:I" & fin1
 
    Sheets("Devis avec date non formalisée").Select
    plagetableau2 = "B2:I" & fin2
 
    Sheets("Devis sans date CEC").Select
    plagetableau3 = "B2:I" & fin3
 
End If
 
End Sub
Private Sub CheckBox2_Click()
'suspendus
If CheckBox2.Value = True Then
    body = Sheets("Paramètres").Cells(29, 5).Value '"E29"
    objet = Sheets("Paramètres").Cells(29, 4).Value '"D29"
    onglet = "Devis suspendus en anomalie"
    fin = Sheets("Devis suspendus en anomalie").Range("B2").End(xlDown).Row
    Sheets("Devis suspendus en anomalie").Select
    plagetableau = "B2:I" & fin
End If
End Sub
Private Sub CheckBox3_Click()
'acceptés
If CheckBox3.Value = True Then
    body = Sheets("Paramètres").Cells(25, 5).Value '"E25"
    objet = Sheets("Paramètres").Cells(25, 4).Value '"D25"
    onglet = "Devis passant en CEC"
    fin = Sheets("Devis passant en CEC").Range("B2").End(xlDown).Row
    Sheets("Devis passant en CEC").Select
    plagetableau = "B2:I" & fin
End If
End Sub
 
Private Sub CommandButton1_Click()
 
Dim ol As New Outlook.Application
Dim Olmail As MailItem
Dim Texte As String
Dim onglet As String
Dim plagetableau As String
Dim fin As Long
Dim mailCP As String, mailcc As String, objet As String, body As String, body1 As String, body2 As String, body3 As String
Dim marche As Integer
 
Dim onglet1 As String
Dim onglet2 As String
Dim onglet3 As String
Dim plagetableau1 As String
Dim plagetableau2 As String
Dim plagetableau3 As String
Dim fin1 As Long
Dim fin2 As Long
Dim fin3 As Long
Dim Selection1 As Range
Dim Selection2 As Range
Dim Selection3 As Range
 
If CheckBox2.Value = True Or CheckBox3.Value = True Then
Call MailOutlook(mailCP, mailcc, objet, body)
ElseIf CheckBox1.Value = True Then
Call MailOutlookAno(mailCP, mailcc, objet, body1, body2, body3)
End If
 
End Sub

Merci d'avance

Cordialement,
BY.

**kiki29** · 14/11/2014, 02h47

Salut, un début de réponse ici ?

**a.ouguerzam** · 15/11/2014, 14h02

Bonjour,

Merci d’essaye le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Mailalertsencad()
Dim Ol As New Outlook.Application
Dim OlMail As MailItem
Dim CurrFile As String
Dim ListeDEST As String
Dim ListeCC As String
 
Worksheets("Nom de feuil").Activate
Sheets("Nom de feuil ").Visible = True
ActiveSheet.Range("A1:R77").Select ' la plage de cellules à envoyer
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
    .Introduction = ""
    .Item.To = Sheets("Nom de feuil ").Range("AF10") & (" ; ") & Sheets("Nom de feuil ").Range("AF11")
    .Item.CC = Sheets("Nom de feuil ").Range("AF14") & (" ; ") & Sheets("Nom de feuil ").Range("AF15") & (" ; ") & Sheets("Nom de feuil ").Range("AF16") 
    .Item.Subject = " l’objet "
    .Item.Send
    MsgBox " un message a mettre apres l’envoi du mail " & vbCr & " Merci "
    ThisWorkbook.Save
End With
End Sub