Bonjour,
Je souhaiterai savoir s'il existe un moyen d'envoyer dans le corps d'un mail une image sachant que cette dernière est à prendre dans la feuille Excel et non sur un chemin disque.
de plus j'ai une mise en forme conditionnelle de couleur qui n'est pas reprise dans mon mail si vous avez une idée.
J'utilise cette macro:
Function mail_outlook_Expert_RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String 'déclaration du fichier temporaire
Dim TempWB As Workbook 'déclaration du classeur temporaire
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'Création du fichier HTML (.htm et .html créent exactement le même fichier)
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".html"
'Copie la plage de données et crée un nouveau classeur pour coller les données dedans
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
'Publier la feuille dans un fichier htm
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
'Lire toutes les données du fichier htm dans RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
mail_outlook_Expert_RangetoHTML = ts.ReadAll
ts.Close
mail_outlook_Expert_RangetoHTML = Replace(mail_outlook_Expert_RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")
'Ferme le classeur temporaire TempWB
TempWB.Close savechanges:=False
'Tue le fichier .htm utilisé dans cette fonction
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Function
Merci d'avance
Je souhaiterai savoir s'il existe un moyen d'envoyer dans le corps d'un mail une image sachant que cette dernière est à prendre dans la feuille Excel et non sur un chemin disque.
de plus j'ai une mise en forme conditionnelle de couleur qui n'est pas reprise dans mon mail si vous avez une idée.
J'utilise cette macro:
Function mail_outlook_Expert_RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String 'déclaration du fichier temporaire
Dim TempWB As Workbook 'déclaration du classeur temporaire
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'Création du fichier HTML (.htm et .html créent exactement le même fichier)
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".html"
'Copie la plage de données et crée un nouveau classeur pour coller les données dedans
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
'Publier la feuille dans un fichier htm
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
'Lire toutes les données du fichier htm dans RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
mail_outlook_Expert_RangetoHTML = ts.ReadAll
ts.Close
mail_outlook_Expert_RangetoHTML = Replace(mail_outlook_Expert_RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")
'Ferme le classeur temporaire TempWB
TempWB.Close savechanges:=False
'Tue le fichier .htm utilisé dans cette fonction
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Function
Merci d'avance