XL 2019 Mail d'alerte automatique contenant tableau si condition remplie

Bidexcel · 17 Mars 2023

Bonjour à tous,

Je viens vers vous ce matin pour demander votre sur un projet. J'ai un tableau contenu dans une feuille nommée "Résumé", je souhaiterais tout d'abord effectuer un filtre sur la colonne "L" des lignes du tableau contenant le critère "Vrai". Ensuite faire une capture écran du tableau filtré et insérer dans le corps d'un Email pour envoi.
Le mail devra etre envoyer automatiquement à l'ouverture du fichier.

Je suis pas callé en VBA mais j'essaie d'adapter ce code que j'ai retrouver sur internet à mon modele :

VB:

Sub Filtrer_colonne_L_et_envoyer_email()
    
    'Activer la feuille contenant le tableau
    Sheets("Resumé").Activate
    
    'Définir le tableau
    Dim Tableau As ListObject
    Set Tableau = ActiveSheet.ListObjects("Tableau_resume")
    
    'Appliquer le filtre sur la colonne L avec le critère spécifié
    Tableau.Range.AutoFilter Field:=11, Criteria1:="Vrai"
    
    'Copier le tableau filtré en tant qu'image
    Dim img As Picture
    Set img = Tableau.Range.CopyPicture(xlScreen, xlPicture)
    
    'Coller l'image dans le corps d'un nouvel e-mail
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "aa@gmail.com"
        .Subject = "Tableau filtré"
        .HTMLBody = "<html><body><p>Le tableau filtré est ci-dessous:</p>" & _
                    "<p><img src='cid:tableau'></p></body></html>"
        .Display
    End With
    
    'Ajouter l'image en tant que pièce jointe et définir son nom en tant que "tableau_filtre.png"
    Dim chemin_image As String
    chemin_image = Environ("temp") & "\" & "tableau_filtre.png"
    img.Copy
    With OutMail
        .Attachments.Add chemin_image, olByValue, 0
        .Attachments.Item(1).DisplayName = "tableau_filtre.png"
        .HTMLBody = Replace(.HTMLBody, "cid:tableau", .Attachments.Item(1).PropertyAccessor.BinaryToString(.Attachments.Item(1).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")))
        .Display
    End With
    
    'Effacer le filtre
    Tableau.Range.AutoFilter
    
End Sub

Je bloque cependnat sur cette ligne de code avec l'erreur 424

Si vous pouviez m'aider à résoudre cela ca serait TOP. Merci d'avance
Le fichier en question

Bidexcel · 24 Mars 2023

Bonsoir à tout le monde
S'il vous plait personne pour m'aider ?
j'ai toujours la même erreur avec ce code je sais vraiment pas ce qui cloche si vous pouviez m'orienté

VB:

Sub EnvoiMail()

    Dim rng As Range
    Dim tbl As ListObject
    Dim olApp As Object
    Dim olMail As Object
    Dim dest As String
   
    'Définir la plage à filtrer
    Set rng = Sheets("Resumé").Range("A1:K100")
   
    'Vérifier si la colonne K contient Vrai
    If WorksheetFunction.CountIf(rng.Columns("K"), "Vrai") = 0 Then
        'Annuler le filtre, afficher un message et sortir de la procédure
        rng.AutoFilter
        MsgBox "Pas de plus à réaliser pour le moment"
        Exit Sub
    Else
        'Filtrer la colonne K avec comme critère Vrai
        rng.AutoFilter Field:=11, Criteria1:="Vrai"
       
        'Nommer la plage filtrée en TableauFiltre
        Set tbl = rng.ListObject
        tbl.Name = "TableauFiltre"
       
        'Copier TableauFiltre et le coller comme image modifiable dans le corps du mail
        Set olApp = CreateObject("Outlook.Application")
        Set olMail = olApp.CreateItem(0)
        dest = "amouedra@bou.com"
        With olMail
            .To = dest
            .Subject = "Plus-values réalisables"
            .HTMLBody = "Voici les plus-values réalisables : <br><br>" & tbl.Range.CopyPicture(xlScreen, xlPicture).ToHTMLTable & "<br>"
            .Display
        End With
       
        'Envoyer le mail
        olMail.Send
       
        'Annuler le filtre
        rng.AutoFilter
    End If

Cordialement

fanch55 · 21 Avril 2023

Bonjour,
Un peu tard, mais si toujours d'actualité , code pour classeur fourni .

VB:

Sub Filtrer_colonne_L_et_envoyer_email()
'Activer la feuille contenant le tableau
 Sheets("Resumé").Activate
 
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "aa@gmail.com"
        .Subject = "Tableau filtré"
        .Display ' pour pouvoir exploiter le wordeditor
         Sig = .body ' Pour récupérer la signature éventuelle
        .body = ""
        With .GetInspector.WordEditor
            .Content.InsertBefore _
                "Bonjour, " & vbLf & _
                "Le tableau filtré est ci-dessous:" & vbLf
            
            .Content.InsertParagraphAfter
             Range("Tableau_resume[#All]").AutoFilter Field:=11, Criteria1:="Vrai"
             Range("Tableau_resume[#All]").CopyPicture
            .Paragraphs(4).Range.Paste
            
            .Content.InsertParagraphAfter
            .Content.InsertAfter vbLf & "Cordialement,"
            .Content.InsertAfter Sig
        End With
'        .send   ' à decommenter pour envoi effectif
    End With
End Sub

XL 2019 Mail d'alerte automatique contenant tableau si condition remplie

Bidexcel

XLDnaute Nouveau

Pièces jointes

Bidexcel

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Discussions similaires