Insérer une capture de mon tableau dans mail

Bonjour à tous,

Alors voilà, je me sers régulièrement de la macro ci-dessous pour créer des outils de suivi et de reporting qui envoie des mails automatiquement.

Cette fois, je souhaiterais que dans mon mail soit directement un copié/collé de mon tableau au format image. Ne seraient copié/collé que les lignes qui ont un statut "Non diffusé".

Merci d'avance de votre aide, n'hésitez pas à revenir vers-moi si quelque choses n'est pas clair.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' envoi un mail automatique avec le contenu de l'anomalie
' Consignes de migration: rajouter un statut "Non diffusée" dans la dernière colonne du tableau
' Donner accès à Excel 2010
' Intégrer la liste de diffusion
' Contrôle de statut " Non diffusée

Dim ol As Object, monItem As Object
Dim i
Dim j
Dim k
Dim cont
Dim fournisseur
Dim cause
Dim ASN
Dim commentaire
Dim da
Dim signature

i = 2
j = 2
te = 0
k = 2

' On récupère la ou les lignes concernées par un éventuel envoi
For i = 2 To 2000

    If Worksheets("Recap").Range("P" & i).Value = "Non diffusée" Then
    Worksheets("Recap").Range("R" & j).Value = i
    j = j + 1
    End If

Next i

' On envoie les mails concernés

While Worksheets("Recap").Range("R" & k).Value <> ""
    cont = CInt(Worksheets("Recap").Range("R" & k).Value)
    'On récupère les données
    fournisseur = Worksheets("Recap").Range("C" & cont).Value
    ASN = Worksheets("Recap").Range("D" & cont).Value
    cause = Worksheets("Recap").Range("M" & cont).Value
    commentaire = Worksheets("Recap").Range("N" & cont).Value
    da = Worksheets("Recap").Range("A" & cont).Value
    signature = Worksheets("Recap").Range("AG3").Value

    'On envoit le mail en question
    Set ol = CreateObject("outlook.application")
    Set monItem = ol.CreateItem(olMailItem)
    'monItem.To = " blabla@bla.com "
    monItem.To = " blabla@bla.com "
    monItem.Cc = " blabla@bla.com "
    monItem.Subject = "Anomalie de réception matière_Deret_" & fournisseur
    monItem.Body = "Bonjour," & Chr(13) & Chr(13) & "Nous ne pouvons pas réceptionner une livraison du fournisseur " & fournisseur
    monItem.Send
    Set ol = Nothing
    k = k + 1

    'On change le statut de l'anomalie
    Worksheets("Recap").Range("P" & cont).Value = "ATT"
Wend

Worksheets("Recap").Range("R2:R40").ClearContents

End Sub

Bonjour,

Pourrais tu joindre un fichier stp pour resituer ton code

[EDIT] : Ce n'est pas possible d'enregistrer un tableau Excel au format image au mieux tu peu joindre un pdf de ton tableau

Merci

Re,

Le code ci-dessous permet d'exporter une plage de données au format PDF et l'enregistre dans le dossier parent de ton fichier EXCEL

Sub Save()
Dim Chemin As String
Dim Plage As Range

Set Plage = Sheets("Feuil1").Range("A1:D4") 'Plage de donné de ton tableau
Chemin = ThisWorkbook.Path & "\" & "Essai.pdf" 'Enregistre sous le nom Essai dans le même dossier que ton fichier XL

Application.ScreenUpdating = False

    Plage.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=True, OpenAfterPublish:=False

Application.ScreenUpdating = True
End Sub

J'espère t'avoir aidé

Hello Fazzbetter, merci de ton aide, mais cela ne correspondra pas aux attentes que j'ai derrière. Est-il possible de faire un simple copié/collé de mes lignes dans le mail alors ?

Bonjour,

Vois si le code suivant de convient :

1- A mettre dans un module :

Sub EnvoiMailIntervention()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim Plage As Range

    Set Plage = ThisWorkbook.Worksheets("Feuil1").Range("A1:D4")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail

        .To = "test@test.fr"
        .Subject = "L'objet du Mail"

        ' ici on utilise la fonction qui converti la plage Excel en données HTML
        .HTMLBody = RangetoHTML(Plage)

        ' afficher
        .Display
    End With

    Set OutApp = Nothing
    Set OutMail = Nothing
    Set Plage = Nothing
End Sub

2 - Fonction à mettre dans le même module que la macro au dessus :

Function RangetoHTML(ByVal rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        .Columns.AutoFit
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    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=")

    TempWB.Close savechanges:=False

    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

Re,

J'ai trouver ça aussi mais lorsque l'on met un corps au message le tableau est écraser

Mais cela peu être une piste de recherche pour toi

Sub EnvoiMailSimple()

    Dim Email As Outlook.Application
    Dim EmailMsg As Outlook.MailItem
    Dim Dest As Outlook.Recipient
    Dim RefCIEMKP, NomProjet, DesCIE, NomPreparateur As String

    Set Email = CreateObject("Outlook.Application")
    Set EmailMsg = Email.CreateItem(olMailItem) 'EmailMsg
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.CreateItem(olMailItem)
    Set Email = CreateObject("Outlook.Application")
    Set EmailMsg = Email.CreateItem(olMailItem)
    Sheets("Feuil1").Activate
    Sheets("Feuil1").Range("A1:D4").Select
    Selection.Copy
    Set outlookwordeditor = EmailMsg.GetInspector.WordEditor 'Remplace EmailMsg par ton item(olMailItem)
    outlookwordeditor.Range.PasteAndFormat Type:=wdFormatOriginalFormatting

    EmailMsg.To = "test@test.com"
    EmailMsg.Subject = "Objet"
    EmailMsg.Display

End Sub

L'important dans ce code sont les lignes suivantes :

Sheets("Feuil1").Activate
    Sheets("Feuil1").Range("A1:D4").Select
    Selection.Copy
    Set outlookwordeditor = EmailMsg.GetInspector.WordEditor 'Remplace EmailMsg par ton item(olMailItem)
    outlookwordeditor.Range.PasteAndFormat Type:=wdFormatOriginalFormatting

Si tu trouve quelque chose à ce sujet pourrais tu le mettre sur ce post stp car cela m'intéresse

Merci Fazzbetter, je te tiens au courant.

Bonjour, désolé pour la réponse tardive. Mais en fin de compte j'ai fais en sorte de reporter mes informations via du texte dans mon mail (via macro), ce qui m'a semblé plus simple à réaliser (car je savais déjà le faire ) merci de ton aide !

Rechercher des sujets similaires à "inserer capture mon tableau mail"