XL 2016 Envoi sélection par mail

Tableau123 · 25 Juin 2021

Bonjour,
Je souhaiterais mettre un tableau dans le corps d'un mail et non en pièce jointe.
J'ai réussi à mettre les PJ en les sélectionnant manuellement (code que j'ai récupéré sur internet).
J'ai également réussi à mettre un début de mail + signature mais pas le tableau, ni la suite du message.
Le corps du mail se trouve dans la feuille "Mail".

Pouvez-vous m'aider ?

Merci par avance !

fanch55 · 26 Juin 2021

Bonjour:

VB:

Private Sub CommandButton1_Click()

    Dim xStrFile As String
    Dim xFilePath As String
    Dim xFileDlg As FileDialog
    Dim xFileDlgItem As Variant
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    Dim MaSignature As String
    Dim Cell As Range
    Dim EmailAddr, EmailAddrCC, Subj As String
    Dim Msg1, Msg2, Msg3, Msg4, Msg5 As String

    
    Application.ScreenUpdating = False
    

    
    EmailAddr = Sheets("Mail").Range("B1")
    EmailAddrCC = Sheets("Mail").Range("B2")
    Subj = Sheets("Mail").Range("B3")
    
    Sheets("Mail").Select
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailOut = xOutApp.CreateItem(olMailItem)
    Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
    
    
    
    If xFileDlg.Show = -1 Then
        With xMailOut
            'On récupère la signature
            .Display
            MaSignature = .HTMLBody
            .To = EmailAddr
            .CC = EmailAddrCC
            .Subject = Subj
            .HTMLBody = "<Body>" & _
                        "<p>" & Sheets("Mail").Range("A5") & "</p>" & _
                        "<p>" & Sheets("Mail").Range("A7") & "</p>" & _
                        "<p>" & 3 & "</p>" & _
                        "<p>" & Sheets("Mail").Range("A26") & "</p>" & _
                        "</Body>" & _
                        MaSignature
            .Display
            Sheets("Mail").Range("A9:E23").Copy
            With .GetInspector.WordEditor
                .Paragraphs(3).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
            End With
            For Each xFileDlgItem In xFileDlg.SelectedItems
                .Attachments.Add xFileDlgItem
            Next xFileDlgItem
            .Display
        End With
    End If
    
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Tableau123 · 28 Juin 2021

Ca fonctionne ! Merci beaucoup fanch55 !

XL 2016 Envoi sélection par mail

Tableau123

XLDnaute Nouveau

Pièces jointes

fanch55

XLDnaute Barbatruc

Tableau123

XLDnaute Nouveau

Discussions similaires