wago | Alors solution trouvée, et c'était clairement pas si simple, un grand merci à BrunoM45 du forum developpez.net:
Code :
- Option Explicit
- ' Forum : https://www.developpez.net/forums/d [...] -vba-excel
- ' https://www.developpez.net/forums/u20954/brunom45/
- ' Constante type d'élément Outlook (pour le late binding)
- Const olMailItem As Integer = 0
- ' Constantes Formats de l'email
- Const olFormatHTML As Integer = 2
- ' Ce code permet d'intégrer une plage donnée dans le corps d'un mail
- Private Sub EnvoiMailAvecImg()
- Dim OutApp As Object, OutMail As Object
- Dim RngAcopier As Range
- Dim StrHTML As String
-
- ' Définir la plage des cellules à envoyer
- Set RngAcopier = ThisWorkbook.Sheets("surveillance" ).Range("C2:F3" )
- ' Avec l'application
- With Application
- .EnableEvents = False ' Désactiver les évènements
- .ScreenUpdating = False ' Désactiver le rafraichissement
- End With
- ' Créer une instance Outllok et Mail
- Set OutApp = CreateObject("Outlook.Application" )
- Set OutMail = OutApp.CreateItem(olMailItem)
- With OutMail
- .BodyFormat = olFormatHTML ' Format HTML
- .To = ThisWorkbook.Worksheets("surveillance" ).Range("K2" )
- '.CC = "LaCopie@fai.fr"
- '.BCC = "LaCopieCachee@fai.fr"
- .Subject = ThisWorkbook.Worksheets("surveillance" ).Range("K4" )
- StrHTML = "Bonjour, <br>" & "Vous trouverez ci-dessous le tableau"
- .HTMLBody = StrHTML & RangetoHTML(RngAcopier)
- .Send 'or use .Display
- End With
- With Application
- .EnableEvents = True
- .ScreenUpdating = True
- End With
- ' Effacer les variables objet
- Set RngAcopier = Nothing: Set OutMail = Nothing: Set OutApp = Nothing
- End Sub
- Function RangetoHTML(Rng As Range)
- Dim Fso As Object, Ts As Object
- Dim TempFile As String
- Dim TempWs As Worksheet
- ' Créer le nom du fichier
- TempFile = Environ$("temp" ) & "\" & Format(Now, "dd-mm-yy h-mm-ss" ) & ".htm"
- ' Désactiver le rafraichissement ici aussi
- Application.ScreenUpdating = False
- ' Copier la plage et créer un classeur pour coller les données dedans
- Set TempWs = ThisWorkbook.Worksheets.Add
- Rng.Copy
- With TempWs
- With .Range(Rng.Address)
- .PasteSpecial Paste:=8
- .PasteSpecial xlPasteValues, , False, False
- .PasteSpecial xlPasteFormats, , False, False
- End With
- Application.CutCopyMode = False
- On Error Resume Next
- .DrawingObjects.Visible = True
- .DrawingObjects.Delete
- On Error GoTo 0
- End With
- ' Publier la feuille dans un fichier HTML
- With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
- Filename:=TempFile, Sheet:=TempWs.Name, Source:=Rng.Address, HtmlType:=xlHtmlStatic)
- .Publish (True)
- End With
- ' Lire les données du fichier
- 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=" )
- ' supprimer la feuille
- Application.DisplayAlerts = False
- TempWs.Delete
- Application.DisplayAlerts = True
- ' Supprimer le fichier HTML
- Kill TempFile
- ' Effacer les variables objet
- Set Ts = Nothing: Set Fso = Nothing: Set TempWs = Nothing
- End Function
|
|
