Capture écran + envoi par mail Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
aston01390
Membre habitué
Membre habitué
Messages : 72
Inscrit le : 30 mars 2015
Version d'Excel : 2010

Message par aston01390 » 28 mai 2015, 10:15

Bonjour,

Je viens vers vous car ne m'y connaissant pas trop en VBA j'ai une petite interrogation. Je vous expose mon problème :

Je voudrais une macro permettant de faire une capture écran et envoyer cette capture écran par mail (application mail Outlook).
J'ai déjà essayé de bricoler des choses avec différents sujets de forum trouvés sur le net (je pense avoir fait le tour des sujets) mais impossible de faire ce que je souhaite.

Merci d'avance pour votre aide!!!
p
pijaku
Membre fidèle
Membre fidèle
Messages : 294
Inscrit le : 14 janvier 2010
Version d'Excel : 2010 FR

Message par pijaku » 28 mai 2015, 13:13

Bonjour,

De quoi veux tu réaliser la capture d'écran?

De ton bureau?
Du classeur Excel actif?
D'une photo de ta belle mère?
Cordialement,
Franck
a
aston01390
Membre habitué
Membre habitué
Messages : 72
Inscrit le : 30 mars 2015
Version d'Excel : 2010

Message par aston01390 » 28 mai 2015, 13:48

Bonjour Pijaku et merci pour ton intérêt sur ce sujet,

Pour répondre à ta question c'est une capture d'écran d'une plage de cellule.

J'ai réussi à arranger un code qui marche bien :
Function Screenshot_Mail(Screenshot_To, Screenshot_CC, Screenshot_Subject, Screenshot_body)
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = Screenshot_To
        .CC = Screenshot_CC
        .BCC = ""
        .Subject = Screenshot_Subject
         Screenshot_body = Replace(Screenshot_body, vbCrLf, "<br/>", 1, -1, vbTextCompare)
        .HTMLBody = "<html><body>" & Screenshot_body & "</html></body>"
        .Display
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Private Sub cmdMainMenu_Click()

frmMainMenu.Show

End Sub

Sub cmdEmail_Click()
Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture

Set oRange = Sheets("Feuil1").Range("A1:P37")
Set oCht = Charts.Add

oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
oCht.Export Filename:="C:\Users\Aston\Desktop\Nouveau dossier\monimage2.jpg", Filtername:="JPG"

Screenshot_Mail "To Sample Email Address" & "; " & "To Sample Email Address", "CC Sample Email Address" & _
"; " & "CC Sample Email Address" & "; " & "CC Sample Email Address", "Ecrire un objet", "<font color=red>" & _
"<I>" & "Voici une capture d'écran:  " & "</font>" & "</I>" & _
"<BR>" & "<BR>" & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
"<IMG alt='' hspace=0 src='C:\Users\Aston\Desktop\Nouveau dossier\monimage2.jpg' align=baseline border=0>&nbsp;</BODY>"

DoEvents
oCht.Delete

End Sub
p
pijaku
Membre fidèle
Membre fidèle
Messages : 294
Inscrit le : 14 janvier 2010
Version d'Excel : 2010 FR

Message par pijaku » 28 mai 2015, 13:53

Donc le sujet et clos et résolu?

Si c'est le cas, merci de l'indiquer.
Cordialement,
Franck
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message