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