Envoi objet d'Excel vers Outloock - un peu galére !

[AURACLE68]

Bonjour amis Excellien,

Je rencontre un soucis sur une routine permettant d'envoyer une image depuis Excel vers outloock, le code actuel permet d'envoyer n'importe quoi d'Excel vers outloock mais je n'arrive pas à envoyer dans le corps Outloock mon image d'Excel.

Voici mon code actuel, et dans ligne msg.body je n'arrive pas lui dire qu'il faut mettre mon image situé sur la feuille sheets"image". Je joins le fichier en piéce jointe. Vous trouverez dans l'onglet "IMAGE", la fameuse image que j'aimerais qu'Excel integre dans le corps du mail. Si une âme charitable pouvait me venir en aide, je lui en serait ennormement reconnaissant. Mes connaissance en VBA étant limité.

Dim olapp As Outlook.Application
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Send

ActiveCell.Offset(1, 0).Select
Loop
End Sub

 

[MJ13]

Re : Envoi objet d'Excel vers Outloock - un peu galére !

Bonjour Auracle68

Tu peux tester un code de ce type:

Public NomGlobal
Sub envoi_Feuille()
    SauveImage
    Copier_Feuille_Dans_Fichier
    '---  Envoi par mail
    Dim olapp As Outlook.Application
    Sheets("destinataires").Select
    Range("A11").Select
    'Do While Not IsEmpty(ActiveCell)
    Dim msg As MailItem
    Set olapp = New Outlook.Application
    Set msg = olapp.CreateItem(olMailItem)
    msg.To = ActiveCell.Value
    msg.Subject = Range("A2").Value
    msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
    msg.Attachments.Add NomGlobal
    msg.Attachments.Add ("C:\Temp\Temp.jpg")
    'msg.Send
    msg.Display
    ActiveCell.Offset(1, 0).Select
    'Loop
End Sub
Sub SauveImage()
    Dim Img As Object
    Set Img = Sheets("IMAGE").Shapes("Picture 1")
    Img.Copy
    Set ch = Sheets("IMAGE").ChartObjects.Add(0, 0, Img.Width, Img.Height)
    ch.Border.LineStyle = 0
    ch.Chart.Paste
    ch.Chart.Export "C:\Temp\Temp.jpg", FilterName:="JPEG"
    ch.Delete
End Sub
Sub Copier_Feuille_Dans_Fichier()
    DossierPath = "C:\Temp"
    Dim ws As Worksheet
    Sheets(2).Activate
    NomFichier = Sheets(2).Name
    Sheets(2).Copy
    ActiveSheet.SaveAs Filename:= _
                       DossierPath & "\" & NomFichier, FileFormat:= _
                       xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close
    NomGlobal = DossierPath & "\" & NomFichier & ".xlsm"
End Sub

 

[AURACLE68]

Re : Envoi objet d'Excel vers Outloock - un peu galére !

Désolé pour le retard de ma réponse.

Je vais de ce pas tester ta macro. et surtout merci MJ13 pour avoir répondu.

Amicalement

 

[AURACLE68]

Re : Envoi objet d'Excel vers Outloock - un peu galére !

MJ13, C'est nickel pro, Je te remercie d'avance pour ton aide précieuse.