Copier/Coller Tableau Mail Outlook en VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

J'aimerais effectué un Copier/Copier d'une plage de données de mon classeur Excel et le mettre dans le corps d'un mail Outlook.

Voici le résultat attendu:

Pièce jointe 208214

Voici le code que j'utilise pour le moment:

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
 
Private Sub Cb_MailNewStaff_Click()
        Dim OutApp As Object
        Dim OutMail As Object
 
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
 
        On Error Resume Next
        With OutMail
            .to = "Tot@blabla.com"
            .CC = ""
            .BCC = ""
            .Subject = "Test Macro"
            Worksheets("Sheet1").Range("A43:H53").Copy
            .Body = Range("A43:H53").PasteSpecial
            '.Attachments.Add ActiveWorkbook.FullName
            .Display 'or use .Send
        End With
        On Error GoTo 0
 
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

Comme vous pouvez le voir j'ai essayé la fonction ".PasteSpecial", mais sans succès :/

Avez-vous une idée ?

Merci par avance de votre aide,
Rainmax

28/04/2016, 13h35
Philippe PONS

Salut,

Une idée, mais je n'ai pas testé!
peut être avec la propriété MailItem.HTMLBody.
et en créant une table HTML, avec les valeurs des cellules de ta plage.
Cordialement,
28/04/2016, 14h09
Oliv-

Bonjour,
Plusieurs solutions dans ce sujet : http://www.developpez.net/forums/d15...ail-via-macro/

Bonjour,

Philippe t'a donné la bonne propriété à utiliser : HTMLBody

voici comme je procède de mon côté :

1) une fonction pour créer le tableau en format HTML, à mettre dans un module standard

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
Function RangetoHTML(ByVal rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
 
        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            .Columns.AutoFit
            .Rows.AutoFit
        On Error GoTo 0
    End With
 
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
 
End Function

Un exemple d'appel de la fonction lors de la création d'un 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
' on récupère la plage du tableau
Set rng = Range("A1:Q18")
 
' on crée un mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
' caractéristiques du mail
With OutMail
    .To = "toto@toto.fr"
    .CC = "titi@titi.fr"
    .Subject = "Mon Titre de mail"
    .HTMLBody = "Bonjour à tous, voici un tableau issu d'un fichier excel  : " & RangetoHTML(rng)
 
    ' afficher
    .Display
 
    ' envoyer
    '.Send
End With
 
Set OutApp = Nothing
Set OutMail = Nothing