insérer une capture de mon tableau dans mail Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
S
SoCRacK
Membre habitué
Membre habitué
Messages : 91
Inscrit le : 14 décembre 2016
Version d'Excel : 2016

Message par SoCRacK » 25 juillet 2017, 07:34

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

F
Fazzbetter
Membre habitué
Membre habitué
Messages : 54
Appréciation reçue : 1
Inscrit le : 10 juillet 2017
Version d'Excel : 2010 FR

Message par Fazzbetter » 25 juillet 2017, 10:53

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
(°v°)° :(huuu):
Fazzbetter
F
Fazzbetter
Membre habitué
Membre habitué
Messages : 54
Appréciation reçue : 1
Inscrit le : 10 juillet 2017
Version d'Excel : 2010 FR

Message par Fazzbetter » 25 juillet 2017, 11:20

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é :)

:btres:
(°v°)° :(huuu):
Fazzbetter
S
SoCRacK
Membre habitué
Membre habitué
Messages : 91
Inscrit le : 14 décembre 2016
Version d'Excel : 2016

Message par SoCRacK » 26 juillet 2017, 13:04

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 ?
F
Fazzbetter
Membre habitué
Membre habitué
Messages : 54
Appréciation reçue : 1
Inscrit le : 10 juillet 2017
Version d'Excel : 2010 FR

Message par Fazzbetter » 27 juillet 2017, 08:37

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
(°v°)° :(huuu):
Fazzbetter
F
Fazzbetter
Membre habitué
Membre habitué
Messages : 54
Appréciation reçue : 1
Inscrit le : 10 juillet 2017
Version d'Excel : 2010 FR

Message par Fazzbetter » 27 juillet 2017, 09:48

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 :lol:
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 :D
(°v°)° :(huuu):
Fazzbetter
S
SoCRacK
Membre habitué
Membre habitué
Messages : 91
Inscrit le : 14 décembre 2016
Version d'Excel : 2016

Message par SoCRacK » 27 juillet 2017, 14:26

Merci Fazzbetter, je te tiens au courant.
S
SoCRacK
Membre habitué
Membre habitué
Messages : 91
Inscrit le : 14 décembre 2016
Version d'Excel : 2016

Message par SoCRacK » 18 octobre 2017, 16:24

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 :mrgreen: ) merci de ton aide !
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message