[Résolu] Redimenssionner une image dans Excel avant envoi via Outlook
Hello,
à force de chercher un peu partout, j'ai réussi en mixant plusieurs bout de code pioché un peu partout à envoyer un email à partir d'Excel 2007 via Outlook 2007 en copiant une plage de données en image dans le nouvel email.
Ca marche très bien, le seul truc que je n'arrive pas à faire, c'est de diviser la taille de l'image par 2 afin qu'elle soit moins énorme !.
Mon problème c'est que je ne sais pas quelle est la méthode à appliquer pour sélectionner l'image copiée vers le doc excel temporaire.
Merci pour votre aide.
Puisque j'ai réussi à résoudre mon problème autant vous expliquer à quoi sert ce code, ça peut peut-être servir à quelqu'un:
Il s'agit ici d'envoyer un par email à partir d'Excel, une plage de données convertit en Image. Pour cela, je passe par un workbook temporaire, je copie-colle comme une image la plage source dans le nouveau workbook et une fois cela effectuer, je sauvegarde dans un répertoire temporaire en html.
En sauvegardant en html une image sera enregistrée avec les fichier htm.
Puis j'insère cette même image dans un nouvel email au format html (en l'attachant et en utilisant la méthode 'cid:') qui s'affichera comme dans une page web.
Ensuite j'efface tout : répertoire et fichier temporaire.
Voila c'est surement pas la meilleure méthode mais je suis pas capable de faire mieux
Hello,
à force de chercher un peu partout, j'ai réussi en mixant plusieurs bout de code pioché un peu partout à envoyer un email à partir d'Excel 2007 via Outlook 2007 en copiant une plage de données en image dans le nouvel email.
Ca marche très bien, le seul truc que je n'arrive pas à faire, c'est de diviser la taille de l'image par 2 afin qu'elle soit moins énorme !.
Mon problème c'est que je ne sais pas quelle est la méthode à appliquer pour sélectionner l'image copiée vers le doc excel temporaire.
Merci pour votre aide.
Puisque j'ai réussi à résoudre mon problème autant vous expliquer à quoi sert ce code, ça peut peut-être servir à quelqu'un:
Il s'agit ici d'envoyer un par email à partir d'Excel, une plage de données convertit en Image. Pour cela, je passe par un workbook temporaire, je copie-colle comme une image la plage source dans le nouveau workbook et une fois cela effectuer, je sauvegarde dans un répertoire temporaire en html.
En sauvegardant en html une image sera enregistrée avec les fichier htm.
Puis j'insère cette même image dans un nouvel email au format html (en l'attachant et en utilisant la méthode 'cid:') qui s'affichera comme dans une page web.
Ensuite j'efface tout : répertoire et fichier temporaire.
Voila c'est surement pas la meilleure méthode mais je suis pas capable de faire mieux
Sub pSend_eMsg()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Generation d'une page HTML et des images.
Range("A1:I25").Select
Selection.Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Pictures.Paste.Select
Application.CutCopyMode = False
'Finalement j'ai trouvé tout seul
Set wk = ActiveSheet
wk.Shapes("Picture 1").ScaleHeight 0.6, msoTrue
wk.Shapes("Picture 1").ScaleWidth 0.6, msoTrue
On Error Resume Next
MkDir "C:\email_tmp"
ActiveWorkbook.SaveAs Filename:="C:\email_tmp\email.htm", FileFormat:=xlHtml, _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
destinataire = WorksheetFunction.Proper(Cells(5, 2))
Textemail = "Voici un résumé de notre réunion : "
'Add reference to Microsoft Outlook 9.0 Object Library
'Je ne suis pas l'auteur de ce bout de code mais je l'ai modifié.
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
With objMail
.To = ThisWorkbook.ActiveSheet.Range("$T$1")
.Subject = "Résumé Réunion : "
.BodyFormat = olFormatHTML
.Attachments.Add ("C:\email_tmp\email_files\image001.png")
.HTMLBody = "<html><p><b>" & destinataire & "</b><br><br>" & Textemail & "</p>" & "<img src='cid:image001.png'>"
'.Display
.Send
End With
Set objMail = Nothing
Set objOL = Nothing
'efface le répertoire temporaire
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
FS.Deletefolder "C:\email_tmp"
MsgBox "Email sent to " & destinataire
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Dernière édition:
