Discussion :

[elea74]

Bonjour à tous,

Je cherche un petit peu d'aide pour envoyer des mails depuis Excel à l'aide de VBA.
Plusieurs post parlent déjà de ce sujet et m'ont permis de reprendre la base de code ci-dessous qui fonctionne pour envoyer un seul tableau dans le corps du message, sans texte ni commentaire. (voir résultat capture ci-jointe)

Mon problème est que je n'arrive pas à créer un corps de message avec plusieurs éléments.
En sommes, je voudrais créer un mail du type :

Bonjour,
bla,blabla, ....
[graphique]

bla,bla,bla
[Tableau1]

bla,bal,bla
[tableau 2]

...
[Tableau 5]

bla,bla
Cordialement
Signature

L'ensemble des tableau et graphiques sont à copier coller depuis le Excel.

Voila le code actuel

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
Sub mailling()
 
'ThisWorkbook.RefreshAll
Set OOutlook = CreateObject("Outlook.Application")
Set OMail = OOutlook.CreateItem(olMailItem)
With OMail
       .To = Sheets("Param mails").Range("D2").Value  ' Destinataire
       .CC = Sheets("Param mails").Range("E2").Value  ' en copie à
       .Subject = "Traçabilité produit - " & Sheets("Tab mail hebdo").Range("B2").Value & " - SL" & Right(Sheets("Tab mail hebdo").Range("C2").Value, 2)
       .Body = "Bonjour" & vbLf & Sheets("Tab mail hebdo").Range("A5:F5").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Set OTexte = OMail.GetInspector.WordEditor
            OTexte.Range.Paste
 
       .Display
End With
 
End Sub

Le premier point qui m'agace c'est que le .Body="Bonjour" & vbLf & copier-coller d'un tableau ne renvois pas bonjour puis à la ligne tableau mais seulement le tableau.

De même lorsque je fais un .Body= copier-coller du tableau suivi de .Body= "Bonjour" & vbLf & .Body, j'obtiens :

Bonjour
-1

Il y a clairement des choses qui m'échappent et j'espère ne pas faire doublon avec un post existant que je n'aurais pas trouvé mais la je patauge ...

Merci d'avance à ceux qui auront quelques lumières pour moi

[elea74]

Flute, zut !!

Je viens de réaliser que je n'ai pas tout à fait posté mon message au bon endroit mais je ne trouve pas comment le déplacer dans la section VBA du forum Excel ...

C'est possible de le déplacer ? ou il faut que je le clôture et que je le ré-ouvre ?

[joe.levrai]

Bonjour,

tu peux t'aider de la propriété HTMLBody pour utiliser une plage excel dans ton email

voici une adaptation de ta procédure, en liaison tardive (pour éviter d'avoir à cocher la référence Outlook dans ton projet)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub mailling()
 Dim OOutlook As Object
 Set OOutlook = CreateObject("Outlook.Application")
With OOutlook.CreateItem(0)
       .To = Sheets("Param mails").Range("D2").Value  ' Destinataire
       .CC = Sheets("Param mails").Range("E2").Value  ' en copie à
       .Subject = "Traçabilité produit - " & Sheets("Tab mail hebdo").Range("B2").Value & " - SL" & Right(Sheets("Tab mail hebdo").Range("C2").Value, 2)
       .HTMLBody = "Bonjour" & vbCrLf & vbCrLf & RangetoHTML(Sheets("Tab mail hebdo").Range("A5:F5"))
       .Display
End With
 Set OOutlook = Nothing
End Sub

Et la fonction qui converti ta plage en HTML (à placer 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

[elea74]

Wouhaa !!!

Merci pour cette super réponse écrite en moins de temps qu'il ne m'en faut pour la lire et surtout la décodée

Pour ceux qui pourraient avoir le même besoin que moi, j'ai ajouter ".currentRegion" pour faire la sélection complète du tableau quelque soit le nombre de lignes (je l'écris car il m'a fallu pratiquement 2h pour trouver comment le faire donc si ca peut aider ...).

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
Sub mailling()
 
Dim OOutlook As Object
 
'ThisWorkbook.RefreshAll
 
Set OOutlook = CreateObject("Outlook.Application")
With OOutlook.CreateItem(olMailItem)
 
       .To = Sheets("Param mails").Range("D2").Value  ' Destinataire
       .CC = Sheets("Param mails").Range("E2").Value  ' en copie à
       .Subject = "Traçabilité produit - " & _
            Sheets("Tab mail hebdo").Range("B2").Value & _
            " - SL" & _
            Right(Sheets("Tab mail hebdo").Range("C2").Value, 2) 'Objet du mail
 
       .HTMLBody = "Bonjour" & vbLf & RangetoHTML(Sheets("Tab mail hebdo").Range("A5:F5").CurrentRegion)
 
       .Display
End With
 
End Sub

[halaster08]

Le petit hic c'est que mes tableaux sont à dimensions variable (le nombre de ligne est dynamique), c'est pour cela que j'utilisais la méthode suivante (probablement pas la plus performante mais fonctionnelle)

Code :

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

1
2
3
Sheets("Tab mail hebdo").Range("A5:F5").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy

Dans cette nouvelle solution, j'ai compris que la fonction crée "RangetoHTLM" (dont j'ai globalement compris le fonctionnement mais que je n'aurais pas su écrire) attendait la totalité du tableau soit A5 à Fxxx. Après plusieurs essais infructueux je n'ai pas trouvé comment rédiger correctement pour que le programme me comprenne.

Toute suggestion est la bienvenue

Bonjour,

Comme ceci:

Code :

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

RangetoHTML(Sheets("Tab mail hebdo").Range(Sheets("Tab mail hebdo").Range("A5:F5"), Sheets("Tab mail hebdo").Range("A5:F5").End(xlDown)))

[elea74]

Youpi, youpla,
Grace à vos précieux conseils je suis proche du résultat final souhaité, il me manque un dernier point qui est comment ajouter un graphique dans mon mail dans le .HTMLBody?

J'ai naïvement (et sans conviction) tenté le

Code :

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

RangetoHTML(Sheets("Graph PF").ChartObjects ("PRESTA")

mais comme présumé c'est pas vraiment fait pour.

D'autres tentatives plus ou moins farfelues ne m'on pas donné grand résultats, je m'en remet donc à vous.

PS : Pour les néophytes comme moi qui auraient le même besoin que moi, pour ajouter un contenu selon des conditions, il faut faire le si en dehors du .HTMLBody de la manière suivante :

Code :

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

1
2
3
4
5
6
.HTMLBody = "Début du corps du message"
if condition then
.HTMLBody = .HTMLBody + "message si condition vraie"
else
.HTMLBody = .HTMLBody + "message si condition fausse"
Endif

PPS : Toujours pour les néophytes, pour faire un retour à la ligne ou toute autre mise en forme, il faut utiliser les balises HTLM à l'intérieur des guillemets, par exemple :

Code :

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

.HTMLBody = "Début du corps du message <br> la balise br fait un retour à la ligne lors de l'exécution du code"

[Myriam1964]

Bonjour,

tu peux t'aider de la propriété HTMLBody pour utiliser une plage excel dans ton email

voici une adaptation de ta procédure, en liaison tardive (pour éviter d'avoir à cocher la référence Outlook dans ton projet)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub mailling()
 Dim OOutlook As Object
 Set OOutlook = CreateObject("Outlook.Application")
With OOutlook.CreateItem(0)
       .To = Sheets("Param mails").Range("D2").Value  ' Destinataire
       .CC = Sheets("Param mails").Range("E2").Value  ' en copie à
       .Subject = "Traçabilité produit - " & Sheets("Tab mail hebdo").Range("B2").Value & " - SL" & Right(Sheets("Tab mail hebdo").Range("C2").Value, 2)
       .HTMLBody = "Bonjour" & vbCrLf & vbCrLf & RangetoHTML(Sheets("Tab mail hebdo").Range("A5:F5"))
       .Display
End With
 Set OOutlook = Nothing
End Sub

Et la fonction qui converti ta plage en HTML (à placer 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

Bonjour Joe.levrai
J'ai utilisé votre fonction RangetoHTML qui correspond exactement à ce que je voulais faire.
Petit problème, je ne peux l'appliquer que sur 5 onglets.. à partir du 6e, la fonction mouline et fait planter Outlook.
Auriez-vous une astuce pour résoudre ce problème ?
Merci de votre aide,