Inserer un tableau dans un mail

Version imprimable

Bonjour ,

je souhaiterai personnaliser le corps de mon mail

"Bonjour " & prenom_mail & "," _
Rajouter dans le corps du message un tableau se trouvant dans une feuille

Pouvez vous m'indiquer la syntaxe ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub D_ENVOI_MAIL() Dim Message_MAIL, Titre As String Dim Tableau, Titre As range nom = "Bonjour " & prenom_mail & "," tableau = sheets("TEST").range("A1").currentregion Message_Mail = nom _ & Chr(10) _ & Chr(10) & "Test" _ & Chr(10) & Tableau _ & Chr(10) & Chr(10) _ & Chr(10) & Chr(10) & "Cordialement " _ & Chr(10) & Chr(10)

28/06/2019, 14h23
marot_r
Bonjour.

Qu'est-ce que tu appelles un tableau ?
- Un ensemble de lignes et de colonnes dans une feuille (ex : A10:C15) ?
- Un tableau croisé dynamique ?
- Une table de données ?
- Autre chose ?
Ensuite tu sembles vouloir mettre ce tableau dans du texte ordinaire. Si ce n'est pas une image alors il y a de forte chance pour que ce tableau soit tout déformé car les lettres n'ont pas toutes la même largeur.
Il faudrait sans doute créer un courriel au format HTML qui te permet de spécifier que cette portion de texte est un tableau.
Ici des explications à ce sujet.
https://access.developpez.com/faq/?p...look#mail_html
C'est pour Access mais la syntaxe devrait être très proche, voir identique, pour Excel

Ici une explication sur comment créer un tableau (table) en HTML.
https://www.w3schools.com/html/html_tables.asp

A+
28/06/2019, 14h35
laurent27530
Bonjour,

Pendant que tu me répondais j'étais en train de modifier mon message pour une meilleur compréhension.
Code:

1 2 nom = "Bonjour " & prenom_mail & "," tableau = sheets("TEST").range("A1").currentregion
je voudrais personnaliser mon envoi en rajoutant la variable nom et tableau

concernant le tableau il est en colonnage prédéfini en largeur
Je préfère qu'il ne soit pas pas en format image.
Code:

1 2 3 4 Message_Mail = nom _ & Chr(10) _ & Chr(10) & "Test" _ & Chr(10) & Tableau _

Bonjour Laurent, Bonjour marot,

Dans mes développements, j'utilise un classeur de base.
La demande étant récurrente sur le Forum, je le livre ici à toute fin utile.

Dans les codes suivants
- Test Outlook : si ouvert, fermeture et réouverture d'une session "propre", si fermé, activation
- Une liste d'adresses figure dans une feuille du classeur
- Cette liste est mise en destinataires.
- Un classeur est créé puis mis en pièce jointe
- Une plage de données (Texte et/ou tableau de résultats) est transformée en objet image et collée dans le corps du texte.

Pour plus de clarté, je découpe le développement en 2 modules.
- Gestion Outlook (Test ci-dessus)
- Envoi mail

Attention! Le code doit être adapté à ton besoin.
(pièce jointe, éventuellement envoi mail en boucle, etc...)

Préambule:
Activer les 2 références
Microsoft Outlook vv.v Object Library
Microsoft Word vv.v Object Library

vv.v = version Office utilisée (pour ce qui me concerne 16.0)

Menu Outils\Références de l'éditeur VBE.
Les références y sont classées par ordre alphabétique.

Module standard Mod_envoi_mail

Code:

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
Option Explicit
 
Dim MonItem As Outlook.MailItem
 
'Requiert une référence à la bibliothèque d'objets Word
Dim wdDoc As Word.Document
 
Dim lapj As String
 
Public Sub essai_mail()
 
lapj = "adresse complète de la pièce jointe"
 
Application.DisplayAlerts = False
 
ThisWorkbook.Worksheets("Tb_Bord").Copy
 
With ActiveWorkbook
        .SaveAs _
                Filename:=lapj, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled
        .Close
End With
 
Call Envoi_Documents_Mail
 
Application.DisplayAlerts = True
 
End Sub
 
Sub Envoi_Documents_Mail()
 
'Si Otlook ouvert : ferme la session et en ouvre une autre vierge
'Si Outlook fermé : ouvre une session
 
Call Test_Open_Outlook
 
'Utilise la liaison anticipée
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
 
Dim édit_ol As Outlook.Inspector
 
Dim dermail As Integer
Dim liste_adresses As String
Dim c As Range
 
liste_adresses = ""
With ThisWorkbook.Worksheets("liste_Mails")
        dermail = .Cells(.Rows.Count, 1).End(xlUp).Row
        For Each c In .Range("A1:A" & dermail)
                With c
                        If .EntireRow.Hidden = False Then _
                                liste_adresses = liste_adresses & .Value & ";"
                End With
        Next c
End With
 
'supprimer le dernier point virgule
liste_adresses = Left(liste_adresses, Len(liste_adresses) - 1)
 
Dim objet_mail As String
objet_mail = "Tableau de Bord  Octobre 2018"
 
Application.ScreenUpdating = False
 
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
 
'Créer l'élément de mail et le transmettre
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
 
With MonItem
 
        .BodyFormat = olFormatHTML
        .To = liste_adresses
        .Subject = objet_mail
        .Display
        '.Body = "Coucou" & Chr(13) & "Voici le rapport" & Chr(13) & Worksheets("Message").[A1]
        .Attachments.Add lapj
        Application.wait (Now + TimeValue("0:00:01"))
 
        On Error Resume Next
        AppActivate objet_mail & " - Message (HTML)" ' Active Outlook
        AppActivate objet_mail & " - Message" ' Active Outlook
        On Error GoTo 0
 
        'https://www.developpez.net/forums/d1334291/logiciels/microsoft-office/outlook/vba-outlook/copier-coller-tableau-excel-corps-mail/
        Set édit_ol = .GetInspector
        'Portée module
        Set wdDoc = édit_ol.WordEditor
 
        'copie du corps de texte dans le corps de message
        Call Création_img
 
        Set wdDoc = Nothing
        Set édit_ol = Nothing
 
        .Send
 
        Application.CutCopyMode = False
 
End With
 
Set MonItem = Nothing
Set Applic_Outlook = Nothing
 
ActiveWindow.DisplayGridlines = True
 
End Sub
 
Sub Création_img()
 
Dim S As Shape
 
With Worksheets("Message")
 
        .Activate
 
        ActiveWindow.DisplayGridlines = False
 
        'Précaution éventuelle, suppression de toutes les images
        If .Shapes.Count > 0 Then
                For Each S In .Shapes
                        With S
                                If InStr(.Name, "Retour") + InStr(.Name, "Logo") = 0 Then .Delete
                        End With
                Next S
        End If
 
        .Range("corps_message").CopyPicture Appearance:=xlScreen, Format:=xlPicture
 
        .Paste
 
        .Shapes(.Shapes.Count).Copy
 
        With wdDoc
                    'Image en en-tête du corps de texte d'Outlook, au-dessus de la signature éventuelle
                    .Range(0, 0).PasteAndFormat Type:=wdChartPicture
                    'Image redimensionnée
                    .InlineShapes(1).Width = 725
        End With
 
        Application.CutCopyMode = False
 
        .Shapes(.Shapes.Count).Delete
 
End With
 
End Sub

Module standard Mod_Gestion_Outlook

(Pas de moi ;) :oops:)

Code:

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
Option Explicit
 
 Public Declare Function SetWindowPos _
        Lib "user32" ( _
            ByVal Hwnd As Long, _
            ByVal hWndInsertAfter As Long, _
            ByVal x As Long, ByVal y As Long, _
            ByVal cx As Long, ByVal cy As Long, _
            ByVal wFlags As Long) _
    As Long
 
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
 
''https://www.extendoffice.com/documents/excel/2030-keep-excel-window-on-top.html
 
Sub Test_Open_Outlook()
 
Dim Chemin As String
Chemin = "C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.exe"
 
Dim Appli As Object
Dim session_Outlook As New Outlook.Application
Dim Ole_appli As Object
 
Dim typouv As Byte
typouv = 1
 
On Error Resume Next
Set Appli = GetObject(, "Outlook.Application")
 
Call ShowXLOnTop(True)
 
If Appli Is Nothing Then
 
      'Ouvre Outlook
        session_Outlook = Shell(Chemin, typouv)
 
Else
 
        'Fermeture de l'application Outlook si ouverte et réouverture d'une nouvelle
        Call KillProcess("Outlook.exe")
 
        session_Outlook = Shell(Chemin, typouv)
 
End If
 
Set Ole_appli = Nothing
Set Appli = Nothing
 
Call ShowXLOnTop(False)
 
End Sub
 
Sub ShowXLOnTop(ByVal OnTop As Boolean)
    Dim xStype As Long
 
Dim xHwnd As Long
 
If OnTop Then
        xStype = HWND_TOPMOST
    Else
        xStype = HWND_NOTOPMOST
    End If
    Call SetWindowPos(Application.Hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
 
 'https://vb.developpez.com/faq/?page=Systeme#killprocess
 
 Public Function KillProcess(ByVal ProcessName As String) As Boolean
    Dim svc As Object
    Dim sQuery As String
    Dim oproc
    Set svc = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_process where name='" & ProcessName & "'"
    For Each oproc In svc.execquery(sQuery)
        oproc.Terminate
    Next
    Set svc = Nothing
End Function

Si des avis peuvent être formulés, alors ils seront les bienvenus.

Bonjour,

Ton exemple est complet merci encore mais cela ne reponds vraiment a mon attente

j'ai refais la macro

il refuse ma zone_mail c 'est dire Sheets("Mail").Range("A1:E20")
Je veux l'ajouter a mon corps sans la mettre en image.
dois je définir ma variable zone_mail avec un type particulier.....

Code:

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
    Dim OutlookApp As New Outlook.Application
    Dim NewMail    As Outlook.MailItem
    Dim zone_mail As range
 
cpt = Sheets("Menu").Range("D65536").End(xlUp).Row
cpt2 = Sheets("Source").Range("A65536").End(xlUp).Row
 
 
 
For L = 6 To cpt
Sheets("Mail").Cells.Clear
nom = Sheets("Menu").Range("D" & L)
date_ext = Sheets("Menu").Range("C11")
heure_ext = Format(Sheets("Menu").Range("C14"), "HH:MM:SS")
prenom_mail = Application.VLookup(nom, Sheets("Managers").Range("A:D"), 3, 0)
mail_manager = Application.VLookup(nom, Sheets("Managers").Range("A:D"), 4, 0)
mail_equipe = "test@test.com"
 
'mail
   Titre = "Voici l'écart pour ton équipe au " & date_ext & " à " & heure_ext
   zone_mail = Sheets("Mail").Range("A1:E20")
   Politesse = "Bonjour " & prenom_mail & ","
   Set NewMail = OutlookApp.CreateItem(olMailItem)
 
    'Liste des destinataires
    With NewMail
       .Recipients.Add mail_manager
 
 
       'Sujet :
       .Subject = Titre
       'Copies
       '.CC = mail_equipe
 
       'Corps du mail :
       .Body = Politesse & vbCrLf _
       & vbCrLf _
       & "Voici les personnes en écart au " & date_ext & " à " & heure_ext & vbCrLf _
       & vbCrLf _
       & zone_mail & vbCrLf _
       & vbCrLf _
       & "Cordialement" & vbCrLf _
 
       .Display
       'Envoi :
       .Send
 End With
 Application.Quit
Next
End Sub

28/06/2019, 15h48
MarcelG

Salut Laurent,

Tu l'auras compris, mon post est un rebond sur cette discussion.
Je ne gère, pour ma part, jamais de corps de texte.
Celui-ci se trouve dans le classeur Excel au-dessus des tableaux de statistiques.
La plage copiée en image comprend l'ensemble.
Bien entendu, la mise en forme, le tableau, et la pièce jointe sont variables au sein d'un même projet.

Voilà.

Bon week-end à marot et à toi. Bon week-end au Forum.

Bonjour.

On ne peut insérer directement une plage dans du texte.
Il est absolument nécessaire soit de la convertir en image, soit de faire du code pour lire le contenu et le mettre en forme.

Pour intégrer le texte et sans s'occuper de conserver l'alignement d'une ligne à l'autre tu peux faire quelque chose comme ceci:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 dim Tableau as string dim ligne as range dim cellule as range for each ligne in Sheets("Mail").Range("A1:E20").rows if tableau<>"" then tableau=tableau & vbnewline end if for each cellule in ligne.cells tableau=tableau & " | " & cellule.text next cellule tableau=tableau & " |" next ligne
Il faudra sans doute se tourner vers quelques chose de plus complexe pour un meilleur résultat (HTML, Word).

A+

28/06/2019, 17h28
marot_r

Aussi, une façon simple de contourner le problème de la mise en forme pour obtenir un tabeau est de ne pas présenter tes données en tableau mais comme une sucession de ligne.

Quelque chose comme :
Point Important (1ère colonne, 1ère ligne)

Autres infos (2ième colonne)
Autres infos (3ième colonne)
Autres infos (4ième colonne)
Autres infos (5ième colonne)
etc.
Point Important (1ère colonne, 2ième ligne)

Autres infos (2ième colonne)
Autres infos (3ième colonne)
Autres infos (4ième colonne)
Autres infos (5ième colonne)
etc.

C'est moins "dense" comme info mais c'est BEAUCOUP plus simple à faire.

A+