XL 2016 Envoi d'un onglet de mon classeur excel par mail

PETIT YANNICK

XLDnaute Occasionnel
Bonjour a tous,


j'ai un fichier avec plusieur onglet.
Je souhaite copier le tableau présent dans l'onglet Demande_validation_plan ( celui n'a jamais le meme nombre de ligne.) et coller ce tableau dans la zone de texte de Outlook.
Avez vous une idée sur la facon de procéder?

Voici le code que j'utilise,la partie en rouge ne fonctionne pas


Sub Envoidu_Mail_Outlook()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'corps du message si besoin
strbody = Contenu

Tableau = Sheets("Demande_validation_plan").Range("A1:G" & Sheets("Demande_validation_plan").Range("A1").End(xlDown).Row).Copy


With OutMail
.To = "xxxxxx@gmail.com" 'destinataire(s)
.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' copie
'.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com" ' si BCC
.Subject = "VALIDATION DE PLAN."
.Body = Tableau

'Piece_jointe
.Display 'ouvre Outlook
'.Attachments.Add ("C:\test.txt") 'mettre chemin et fichier a joindre
'or use
'.Send 'envoi sans ouvrir Outlook
End With
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, PETIT YANNICK

PETIT YANNICK

Si j'étais moi, je me convaincrai de te suggérer d'aller poser tes yeux tout en bas de la page.
Là où ils pourront lire Discussions similaires
;)
Reste ensuite à me convaincre de te convaincre de cliquer sur un des dix liens présents ;)
 

PETIT YANNICK

XLDnaute Occasionnel
Bonsoir le fil, PETIT YANNICK

PETIT YANNICK

Si j'étais moi, je me convaincrai de te suggérer d'aller poser tes yeux tout en bas de la page.
Là où ils pourront lire Discussions similaires
;)
Reste ensuite à me convaincre de te convaincre de cliquer sur un des dix liens présents ;)

Bonsoir Staple1600,

suite a vos conseils, j'ai continuer a chercher sur les forums.
j'ai trouvé un bout de réponse par ce code , il fonctionne pas mal, la partie rouge pour l'insertion de tableau
Par contre je souhaite insérer du texte avant le tableau et je ne sais pas comment la fontionne

Savez vous comment procéder?



Sub envoi_mail()
Dim olk As Object, email As Object, wdDoc As Object
Dim erreur As Integer, nb_lignes As Integer
Dim rng As Object

On Error Resume Next 'désactivation routine d'erreur
erreur = False

'Assignation des applications Outlook ,de l'objet email et du body de l'email en tant que document Word
Set olk = CreateObject("outlook.application")
Set email = olk.CreateItem(olMailItem)
Set wdDoc = email.GetInspector.WordEditor

With email
'....... remplissage sujet, objet, et adresse
.To = "xxxxx@yahoo.fr"
.CC = ""
.Subject = "Plans à valider"

'....... corps du mail
.Display



With Sheets("Demande_validation_plan")


'insertion tableau


Sheets("Demande_validation_plan").Range("A1:G" & Sheets("Demande_validation_plan").Range("A1").End(xlDown).Row).Copy
'nb_lignes = .Range("A1:G1").Rows.Count
'
Set rng = wdDoc.Content
rng.Paste



End With

'....... envoie le message
' .Send
' If Err.Number <> 0 Then erreur = True
End With

'Désassignation objets
Set olk = Nothing
Set email = Nothing
Set wdDoc = Nothing
End Sub
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Essaies ce bout de code (sorti de la poussière de mes archives)
Le code original n'est point de moi
J'ai modifié pour avoir une version paramétrée
VB:
Sub test()
'ici modifie le nom de la feuille, la plage de cellules
'l'objet du mail et l'adresse mail du destinataire
CopiePlage_Vers_Outlook Sheets(1).Range("A1:C15"), "Objet mail", "staple1600@domain.com"
End Sub

Private Sub CopiePlage_Vers_Outlook(Rng As Range, vObjet As String, Destinataire As String)
Dim olApp As Object, NewMail As Object, ChartName$, imgPath$, tmpImageName$
Dim RangeToSend As Range, sht As Worksheet, objChart As Chart
On Error GoTo err
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
Set olApp = CreateObject("Outlook.Application")
    tmpImageName = VBA.Environ$("temp") & "\tmpIMG.jpg": Set RangeToSend = Rng
    ' Copie de la plage en tant qu'image JPG
    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set sht = Sheets.Add: sht.Shapes.AddChart
    sht.Shapes.Item(1).Select: Set objChart = ActiveChart
    With objChart
        .ChartArea.Height = RangeToSend.Height: .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = 0: .ChartArea.Border.LineStyle = -4142
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With
    sht.Delete
    'Creation du mail
    Set NewMail = olApp.CreateItem(0)
    With NewMail
        .Subject = vObjet
        .To = Destinataire
        .Body = "Texte dans le corps du message"
        .Display
    End With
err:
Set olApp = Nothing: Set NewMail = Nothing: Application.DisplayAlerts = -1
End Sub 'source:2016-11-13T17:13:47+00:00(learnxl)
 
Haut Bas