Envoyer un mail automatique avec capture d'écran

Le 16/08/2021 à 18:47

Bonjour,

Je me permets de créer un post sur ce forum car, en effet, depuis un certain temps je cherche à créer un fichier Excel qui permet :

1- d'une part d'enregistrer la liste des commandes envoyées à des points de collecte (a, b, c...)

2- d'autre part qui permet d'envoyer un mail automatique listant les commandes que doit recevoir le point de collecte "a" sur la semaine "x"

Concernant le premier point : pas de problème, mais là où cela se corse concerne le second...

Après avoir regardé de nombreux forums et vidéos YouTube afin de créer un code VBA qui permet l'envoie automatique du mail avec joint une capture de la feuille de calcul qui reprend la liste des commandes, j'ai réussi à obtenir un premier code. Cependant, ce dernier ne me convient pas tout à fait car lorsque je l'exécute, un mail est bien créé et envoyé mais la capture qui est réalisée ne correspond pas à la bonne feuille de calcul car elle vient faire la capture de la feuille active et non pas de la feuille voulu (j'aimerai alors avoir la capture de la feuille "RÉCAP COMMANDE").

Voici les codes des deux modules qui me permettent d'effectuer l'envoie du mail :

Le 1er module ("module 4") qui vient (de ce que j'ai compris) paramétrer la capture d'écran :

Function ExportRangeAsImage(ws As Worksheet, _
                       rng As Range, _
                       sFile As String) As Boolean
    Dim oChart                As ChartObject

    On Error GoTo Error_Handler

    Application.ScreenUpdating = False
    ws.Activate
    rng.CopyPicture xlScreen, xlPicture     'Copy Range Content
    Set oChart = ws.ChartObjects.Add(0, 0, rng.Width, rng.Height)    'Add chart
    oChart.Activate
    With oChart.Chart
        .Paste    'Paste our Range
        .Export sFile, "JPG"    'Export the chart as an image
    End With
    oChart.Delete    'Delete the chart
    ExportRangeAsImage = True

Error_Handler_Exit:
    On Error Resume Next
    Application.ScreenUpdating = True
    If Not oChart Is Nothing Then Set oChart = Nothing
    Exit Function

Error_Handler:
'76 - Path not found
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExportRangeAsImage" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Le 2ème module ("module 1") qui vient paramétrer l'envoie du mail avec incorporation de la capture :

Sub EnvoyerMail()

Dim fich As String
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Dim simage$
        simage = ThisWorkbook.Path & "\Récap_Commande.jpg"
    Dim Retour
        Retour = ExportRangeAsImage(Sheets("RÉCAP COMMANDE"), [A1:R200], simage)
        Set rng = Sheets("RÉCAP COMMANDE").[A1:R200]

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Sheets("MAIL TRANSPORT").Select
With OutMail
    .To = [b3]
    .CC = ""
    .Subject = [c7]
    .Body = [c9]
    .Attachments.Add simage
    .Display
End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Étant novice sur le codage, je n'y comprends pas grand chose et même après s'y être intéressé de longues heures je n'arrive toujours pas à résoudre mon problème... C'est pourquoi je me tourne vers vous en espérant que vous comprendrez mon problème. Malheureusement je n'arrive pas à vous laisser ci-joint mon fichier car il doit être trop volumineux (1,890 mo)...

Un grand merci à vous déjà pour avoir pris le temps de lire ce sujet !

P.S : Désolé pour le grand nombre de macro que vous verrez, elles sont surement pas optimales mais répondent à ce que je veux pour l'instant

Le 16/08/2021 à 18:51

Re-

Après suppression de feuilles inutiles j'ai réussi à comprimer mon fichier, le voici donc !

31amelioration-saisie-forum.zip (362.93 Ko)

Le 17/08/2021 à 11:31