Copier Plage cellule vers mail en image

bonjour, je bug sur une partie de code, je veux copier une plage de cellule en image dans le corps d'un mail :

Sub envoi_mail()

Sheets("datas").Select

corp_mail_deb = Range("M2").Value
corp_mail_fin = Range("M3").Value
plage_mail = corp_mail_deb & ":" & corp_mail_fin

Sheets("Feuil1").Select

'Définition des objets Outlook et du message.
Dim ObjOutlook As Object
Dim ObjMessage As Object

'Ouverture d'Outlook et création d'un message vierge
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.CreateItem(0)

'mise en variable des entrees du mail
destinataires = ActiveSheet.Range("D3").Value
objet = Range("H1")

' la plage de cellules à envoyer
ActiveSheet.Range(plage_mail).CopyPicture

'affiche le nouveau mail
ObjMessage.Display

'complete les infos d'envoi du mail
ObjMessage.To = destinataires
ObjMessage.Subject = objet

'Libération des variables
Set ObjOutlook = Nothing

Range("A1").Select

End Sub

Mais je n'arrive pas à coller l'image dans le corps du mail, j'ai essayé plusieurs code mais je ne dois pas l'écrire correctement

Bonjour,

après le display, il faut envoyer un "Ctrl+V" pour copier

essaie d'ajouter :

    ObjMessage.display
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys "^v", True

bonjour,

Merci pour ton aide, ca ne fonctionne pas, cela reste vide.

Si je fais un

ObjMessage.body = "test"

il me met bien Test dans le corps du mail mais impossible de coller mon image

Bonjour,

Essayer ce code :

Sub envoi_mail()

    ' Définition des variables
    Dim OL As Object, myItem As Object, wDoc As Object, rng As Object
    Dim nb_lignes As Integer, i As Integer
    Dim plage_mail As Range
    Dim destinataires As Variant, objet As String

    '// assignation des objets
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor

    '//mise en variable des entrées du mail
    With Sheets("datas")
        Set plage_mail = .Range("M2:M3")
    End With
    With Sheets("Feuil1")
        destinataires = .Range("D3").Value
        objet = .Range("H1")
    End With

    '// Prépration du mail avec adresse des destinataires, objet du mail, corps du mail
    With myItem
        .To = destinataires
        .Subject = objet
        .Display

        ' Copie de la plage en image
        plage_mail.CopyPicture
        Set rng = wDoc.Content
        rng.InsertParagraphBefore
        rng.Move wdParagraph, -1
        rng.Paste
        rng.Move wdParagraph

        ' Envoi
        .Send
    End With

    '// désassignation des objets
    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing

 End Sub

NB : les ".Select" sont superflus

Lequel ?

anne64 a écrit :

bonjour,

Merci pour ton aide, ca ne fonctionne pas, cela reste vide.

Si je fais un

ObjMessage.body = "test"

il me met bien Test dans le corps du mail mais impossible de coller mon image

outlook est-il déjà ouvert ?

Steelson a écrit :

anne64 a écrit :

bonjour,

Merci pour ton aide, ca ne fonctionne pas, cela reste vide.

Si je fais un

ObjMessage.body = "test"

il me met bien Test dans le corps du mail mais impossible de coller mon image

outlook est-il déjà ouvert ?

oui

Peux-tu faire ce test :

' la plage de cellules à envoyer
ActiveSheet.Range(plage_mail).CopyPicture
msgbox "faire Ctrl+V dans word par exemple"
'affiche le nouveau mail
ObjMessage.Display

je voudrais m'assurer du contenu du presse-papier ...

Steelson a écrit :

Peux-tu faire ce test :

' la plage de cellules à envoyer
ActiveSheet.Range(plage_mail).CopyPicture
msgbox "faire Ctrl+V dans word par exemple"
'affiche le nouveau mail
ObjMessage.Display

je voudrais m'assurer du contenu du presse-papier ...

Oui j'ai testé, il copie bien en image car il m'ouvre le mail, certes vide, mais si je fais un coller manuellement il colle bien l'image bien copiée

augmente la tempo peut-être

ne touche à rien pendant le déroulé (5 secondes)

    ObjMessage.display
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "^v", True

Bonjour,

voir ma proposition de code ci-dessus mise à jour.

il est probable qu'en faisant send keys il ne soit pas dans la partie texte (ce qui arrive souvent dans l'agenda)

donc mets le sendkeys après avoir défini le destinataire et l'objet

Steelson a écrit :

augmente la tempo peut-être

ne touche à rien pendant le déroulé (5 secondes)

    ObjMessage.display
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "^v", True

Il me prends bien le tempo de 5s mais ne fait pas la fonction "coller"

Ah j'avance, cela fonctionne en faisant cela :

'affiche le nouveau mail
ObjMessage.display

'complete les infos d'envoi du mail
ObjMessage.To = destinataires
'ObjMessage.CC = ""
'ObjMessage.BCC = ""
ObjMessage.Subject = objet
ObjMessage.body = ""
SendKeys "^v", True

Là, ca me colle bien mon image !!!!!

Par contre il me supprime ma signature lol

Bonjour,

Avec mon code, la signature n'est pas supprimée.

thev a écrit :

Bonjour,

voir ma proposition de code ci-dessus mise à jour.

Merci Thev pour ta MAJ, mais il bug à cette ligne ::

 rng.Move wdParagraph, -1

anne64 a écrit :

Merci Thev pour ta MAJ, mais il bug à cette ligne :

Oui, car il ne reconnait pas la constante "wdParagraph".

J'ai oublié de préciser qu'il faut rajouter la référence : Microsoft Word Object Library dans l'éditeur VBA --> Outils

ou remplacer wdParagraph par sa valeur = 4

anne64 a écrit :

Ah j'avance, cela fonctionne en faisant cela :...

Là, ca me colle bien mon image !!!!!

Par contre il me supprime ma signature lol

essaie de remplacer :

ObjMessage.body = ""

par :

ObjMessage.htmlbody = ""

j'utilise ceci et ma signature n'est pas effacée, essaie pour voir ...

Steelson a écrit :

anne64 a écrit :

Ah j'avance, cela fonctionne en faisant cela :...

Là, ca me colle bien mon image !!!!!

Par contre il me supprime ma signature lol

essaie de remplacer :

ObjMessage.body = ""

par :

ObjMessage.htmlbody = ""

---

j'utilise ceci et ma signature n'est pas effacée, essaie pour voir ...

Désolé pour le retard, en adaptant en tant qu'image cela fonctionne nikel !!!

Merci !!!!!