Inserer un graphique dans un mail - correction de code

Le 09/03/2018 à 12:39

Bonjour a tous,,

Je souhaite avoir des avis/aide par rapport au code ci-dessous.

Plusieurs des elements composant le code sont des copies d'autres codes (Merci a toutes les personnes ayant composer ces codes)

Le but du code est le suivant:

Envoyer un mail comprenant un plage de cellule comprenant un graphique sur excel 2013

Le resultat:

l'envoi de mail fonctionne tres bien, seulement mon graphique n'apparait pas, j'ai teste plusieurs code en rapport avec cela mais sans succes.

Ma demande:

Il y a t il quelqu'un qui peut m'aider a comprendre ou a reecrire les lignes du code relatives au graphique s'il vous plait?

Merci pour votre aide.

Ci-dessous le code:

Sub envoi_mail()

' You need to use this module with the RangetoHTML subroutine.

' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.

Dim rng As Range

Dim Date_Sending As String

Dim OutApp As Object

Dim OutMail As Object

Dim adresses_mail As String

Dim mail_CC As String

Dim ChartName As String

Dim ChartPath As String

Dim Path As String

Dim Chart As ChartObject

ThisWorkbook.Worksheets("Weeksaldo 2018").Activate

adresses_mail = Range("T2").Value & Range("T3").Value & Range("T4").Value

Set rng = Nothing

On Error Resume Next

' Only send the visible cells in the selection.

Set rng = Selection.SpecialCells(xlCellTypeVisible)

' You can also use a range with the following statement.

Set rng = ThisWorkbook.Sheets("Weeksaldo 2018").Range("F2:M31").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then

MsgBox "The selection is not a range or the sheet is protected. " & _

vbNewLine & "Please correct and try again.", vbOKOnly

Exit Sub

End If

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

Sheets("Weeksaldo 2018").Activate

Date_Sending = ActiveSheet.Range("N3")

On Error Resume Next

With OutMail

.To = adresses_mail

.CC = mail_CC

.Subject = Range("T6").Value & Date_Sending

.HTMLBody = "Dear Netherlands team," & "<br>" & "<br>" & "Find below the indicative prices for today:" & "<br>" & RangetoHTML(rng) & "<br>" & "<br>" & "Kind regards," & "<br>" & "<br>" & "Europe TPAs & Offers"

.EmailMsg.Display

'.Display

' In place of the following statement, you can use ".Display" to

' display the e-mail message.

.Display

End With

On Error GoTo 0

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Function RangetoHTML(rng As Range)

' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.

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"

' Copy the range and create a workbook to receive the data.

rng.Copy

Set TempWB = Workbooks.Add(1)

With TempWB.Sheets(1)

.Cells(1).PasteSpecial Paste:=8

.Cells(1).PasteSpecial xlPasteValues, , False, False

.Cells(1).PasteSpecial xlPasteFormats, , False, False

.Cells(1).Select

Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True

.DrawingObjects.Delete

On Error GoTo 0

End With

' Publish the sheet to an .htm file.

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

' Read all data from the .htm file into the RangetoHTML subroutine.

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=")

' Close TempWB.

TempWB.Close savechanges:=False

' Delete the htm file.

Kill TempFile

Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing

End Function

Le 10/03/2018 à 01:52

Bonjour,

à tester,

Sub envoi_mail()
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim rng As Range
Dim Date_Sending As String
Dim OutApp As Object
Dim OutMail As Object
Dim adresses_mail As String
Dim mail_CC As String
Dim MyChart As Chart

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Sheets("Weeksaldo 2018")
 adresses_mail = .Range("T2").Value & .Range("T3").Value & .Range("T4").Value
 Date_Sending = Format(.Range("N3"), "mmmm, dd, yyyy")
End With

'enregistrer le graph en image
Set MyChart = Sheets("graph").ChartObjects(1).Chart  'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph1.jpg", filtername:="JPG"

Set ColAttach = OutMail.Attachments
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph1.jpg")

text1 = "Dear Netherlands team," & Chr(12) & Chr(12) & _
        "Find below the indicative prices for today:" & Date_Sending & Chr(12) & Chr(12) & _
        "Kind regards," & Chr(12) & "Europe TPAs & Offers"

With OutMail
.To = adresses_mail
'.CC = mail_CC
.Subject = Range("T6").Value & " " & Date_Sending
.HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & text1 & _
            ", <br><br><IMG src=cid:graph1.jpg></BODY>"   'Nom de l'image sans chemin
.Display
End With

Kill Environ("Temp") & "\graph1.jpg"
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Le 10/03/2018 à 12:06

Bonjour,

N'y a-t'il pas un oubli dans vos procédures?

Soit :

With OutMail
      '
     .Attachments.Add nomFichier
     '
End with
Le 10/03/2018 à 15:13

Bonjour à tous, Jean-Eric,

je l'ai mis juste après avoir créer le fichier

Set ColAttach = OutMail.Attachments
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph1.jpg")
Le 10/03/2018 à 17:22

Bonjour Isabelle & Jean-Eric,

On peut aussi (si le "client" le souhaite) mettre le fichier image dans le corps du mail par un jeu de sendkeys ...

Le 12/03/2018 à 15:10

Bonjour, Merci pour ce code,

je l'ai teste, puis j'ai essaye de l'incorporer dans mon premier code mais auncum resultats dans les deux cas ( mais ce fut un bon entrainement pour une novice comme moi).

J'utilise une version d'Excel de 2013, et je me disait aue peut qu'aucun des codes ne fonctionnent par ce aue le lengage utilise ets peut etre trop developpe pour Excel 2013? je tourne un peu en rond mais votre code m'a beaucoup aide et j'ai decouvert de nouvelles fonctionnalites grace a cela.

Merci encore

sabV a écrit :

Bonjour,

à tester,

Sub envoi_mail()
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim rng As Range
Dim Date_Sending As String
Dim OutApp As Object
Dim OutMail As Object
Dim adresses_mail As String
Dim mail_CC As String
Dim MyChart As Chart

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Sheets("Weeksaldo 2018")
 adresses_mail = .Range("T2").Value & .Range("T3").Value & .Range("T4").Value
 Date_Sending = Format(.Range("N3"), "mmmm, dd, yyyy")
End With

'enregistrer le graph en image
Set MyChart = Sheets("graph").ChartObjects(1).Chart  'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph1.jpg", filtername:="JPG"

Set ColAttach = OutMail.Attachments
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph1.jpg")

text1 = "Dear Netherlands team," & Chr(12) & Chr(12) & _
        "Find below the indicative prices for today:" & Date_Sending & Chr(12) & Chr(12) & _
        "Kind regards," & Chr(12) & "Europe TPAs & Offers"

With OutMail
.To = adresses_mail
'.CC = mail_CC
.Subject = Range("T6").Value & " " & Date_Sending
.HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & text1 & _
            ", <br><br><IMG src=cid:graph1.jpg></BODY>"   'Nom de l'image sans chemin
.Display
End With

Kill Environ("Temp") & "\graph1.jpg"
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Le 12/03/2018 à 16:22

j'ai essaye de l'incorporer dans mon premier code mais auncum resultats

il ne faut pas l'incorporer, mais le remplacer.

voici l'exemple:

403euge-d-mail-graph.xlsm (23.32 Ko)
Le 23/03/2018 à 11:48

Merci c'est parfait!!!!!!

Rechercher des sujets similaires à "inserer graphique mail correction code"