Copie texte + image dans corps de texte pour envois mail

[Fanfan68]

Bonjour le forum,

Aprés un long moment sans besoin d'aide me voila obligé de me rendre à l'évidence....vous êtes indispensable -🙂

Je vous soumets pour soucis :

Sub Envoi_mail()
Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String, sBody As String
Dim sh As Worksheet
Dim rg As Range

Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
Set sh = ActiveSheet

' zone à affecter au corps de texte
Set rg = sh.Range("a17:G60")
rg.Copy

' copie le contenu vers le presse-papiers
With New DataObject
.GetFromClipboard
' et récupère les dernières données
sBody = .GetText(1) 'récupère les données sous format texte
End With

With Olmail
.To = "toto@free.fr"
.CC = ""
.Subject = "Envoi du mail 2009"
.body = sBody
On Error Resume Next
.Send
If Err.Number > 0 Then
MsgBox "Erreur d'envoi : " + Err.Description
End If
On Error GoTo 0
End With
End Sub

Donc, l'idée de cette procédure(dont une partie m'a été inspiré par le forum) est de copier dans une feuille Excel, les données d'une plage et que ces données soient mis dans le corps de texte du mail.

Le soucis avec ce code et nottament la partie ".GetText(1)" c'est que je ne copie que le texte de la plage or, si dans cette plage il y a une image, celle-ci ne sera pas copiée.

Supposons qu'une image se trouve aux environs de la cellule C30 que manuellement, je selectionne sur ma feuille Excel la plage("a17:G60") et que je fasse un copier de cette selection et la colle sur une autre feuille, tout sera copié, aussi bien le texte que l'image, j'ai essayé avec l'enregistreur, ça fonctionne mais comme adapter le code pour qu'il s'insère dans le .body= ????

En espérant avoir été assez claire, je vous remercie pour l'aide que vous pourrez m'apporter

 

[Fanfan68]

Re : Copie texte + image dans corps de texte pour envois mail

Bonjour,

Mon message n'inspire t'il personne ?

Snif....snif....

 

[JNP]

Re : Copie texte + image dans corps de texte pour envois mail

Bonjour Fanfan68 🙂,
Je suis pas convaincu qu'il puisse être possible d'injecter une photo dans le corps de message. Suivant le type de messagerie, l'image est dans le corps, ou en pièce jointe.
Quelques pistes :
Enregistrer ta feuille comme un classeur et le mettre en pièce jointe. Exemple sur ce fil http://www.excel-downloads.com/forum/116649-vba-outlook-envoi-de-fichiers-en-pj.html
Ou essayer de mettre directement l'image dans la pièce jointe

Dim Image As Shape
For Each Image In Sheets("Feuil1").Shapes
.Attachments.Add Image
Next

mais c'est sans garantie...
Bon dimanche 😎

 

[Fanfan68]

Re : Copie texte + image dans corps de texte pour envois mail

Merci JNP de t'être penché sur mon problème, je vais regarder le lien que tu m'as donné

A bientôt

 

[PMO2]

Re : Copie texte + image dans corps de texte pour envois mail

Bonjour,

L'objet DataObject ne permet pas de traiter les images, aussi ai-je fait une toute autre approche
qui permet d'obtenir le résultat souhaité.

Copiez le code suivant dans un module standard

'### Constante d'un fichier temporaire qui sera détruit par la suite ###
Const TEMPO As String = "c:\___pmoTemporaire.jpg"

Sub InsererPlageDansMail()
Call PMO_MakeJPG
End Sub

Sub PMO_MakeJPG(Optional dummy As Byte)
Dim R As Range
Dim CO As ChartObject
On Error GoTo Erreur
If TypeName(Selection) <> "Range" Then
  MsgBox "Veuillez sélectionner une plage contenant éventuellement une image, un graphique."
  Exit Sub
End If
Set R = Selection
R.CopyPicture xlScreen, xlBitmap
With R
  Set CO = ActiveSheet.ChartObjects.Add( _
    .Left, .Top, .Width + 8, .Height + 8)
End With
With CO.Chart
  .Paste
  .Export Filename:=TEMPO
End With
CO.Delete
Set CO = Nothing
Call PMO_PlageMail
Exit Sub
Erreur:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub

Sub PMO_PlageMail(Optional dummy As Byte)
Dim OUT As Outlook.Application
Dim IT As Outlook.MailItem
Dim msgDebut$
Dim msgFin$
Dim A$
Set OUT = CreateObject("Outlook.Application")
Set IT = OUT.CreateItem(olMailItem)
'////////////////////////////////////////////////////////////////
'/// Adapter les lignes ci-dessous SI texte à ajouter au mail ///
'///   Pour ne rien ajouter : msgDebut$ = "" ET msgFin$ = ""  ///
msgDebut$ = "Bonjour,"    'en-tête
msgFin$ = "Cordialement." 'pied du texte
'////////////////////////////////////////////////////////////////
On Error GoTo Erreur
If Dir(TEMPO) <> "" Then
  A$ = msgDebut$ & "<br><br><img src='" & TEMPO & _
      "'><br><br>" & msgFin$ & "</BODY></HTML>"
  With IT
     .Display
     .HTMLBody = A$
     .Subject = "essai"
     .To = "toto@zaza.fr" 'adapter le destinataire
     .Send
  End With
End If
Erreur:
On Error Resume Next
Set IT = Nothing
Set OUT = Nothing
Kill TEMPO
If Err <> 0 And Err <> 287 And Err <> 53 Then _
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub

Il faudra adapter le destinataire ainsi que les éventuels en-tête et pied du texte.

Sélectionnez une plage de cellules (avec ou sans image, graphique, WordArt, organigramme,…) puis lancez
la macro "InsererPlageDansMail".

Cordialement.

PMO
Patrick Morange