Discussion :

[Rainmax]

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:



Voici le code que j'utilise pour le moment:

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
 
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

[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,

[Oliv-]

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

[joe.levrai]

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 :

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
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 :

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
' 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