XL 2016 ecrire du texte avant un tableau dans outlook via une macro dans VBA

[PETIT YANNICK]

Bonjour à tous

je souhaite créé un tableau dans le contenu d'un mail Outlook. Cette partie c'est OK
Par contre je souhaite écrire du texte auparavant. Je le fais via la commande rng.InsertParagraphbefore et rng.InsertBefore "Bonjour," & vbNewLine
Voila ce que cela donne, ca m'écrit le texte dans le tableau.

Je souhaite écrire du texte avant le tableau comme ci dessous

Je ne sais pas comment procéder

Quelqu'un aurait une idées?

Merci d'avance de votre aide

Voici le code utilisé

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


'insertion tableau

With Sheets("Demande_validation_plan")





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



rng.InsertParagraphbefore
rng.InsertBefore "Bonjour," & vbNewLine

rng.Move 4, -1

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

 

[Hasco]

Bonjour,

1 - Pas cool le WorkBook_Open sans en avertir ceux qui, ici, vont ouvrir votre fichier (Heureusement je prends mes précautions)
Ré-éditez votre post 1 supprimez le fichier et remettez-en un sans procédure Workboook_Open!!
2 - on imbrique pas des With pour des objets différents : With Email ... With worksheets ... End With End With

3 - faire les choses dans l'ordre.

macro non testée:

Sub envoi_mail()
    Dim olk As Object, email As Object, wdDoc As Object
    Dim erreur As Integer
    Dim nb_lignes As Long 'Long et pas integer
    Dim rng As Object

    Dim plage As Range
    ' 1 - Définition de la plage à copiée
    With Sheets("Demande_validation_plan")
        Set plage = .Range("A1:G" & .Range("A1").End(xlDown).Row)
        nb_lignes = plage.Rows.Count
    End With

    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
        Set rng = wdDoc.Content
     
        ' Insertion avant la copie du tableau
        rng.InsertParagraphbefore
        rng.InsertBefore "Bonjour," & vbNewLine
         '
         ' Copie du tableau et insertion dans word
        plage.Copy
        rng.Paste

        rng.Move 4, -1
      
       ' Afficher le mail
                 .Display

        '....... 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

bonne journée

 

[PETIT YANNICK]

Bonjour Roblochon,

Merci pour le retour
Oui vous avez raison j'aurais du enlever le workbook open.
J'ai essayer votre macro, il y a que le tableau qui se copie

 

[Hasco]

Re,

Pour opérer sur ma bécane j'ai du référencer Microsoft.Outlook 16 car en late binding (createobject) cela ne fonctionnait pas (wdDoc = nothing)

Avec Set olk = New Outlook.Application cela fonctionne (ne pas oublier de référencer Outllook)

Dans la macro ci-dessous, un paragraph est inséré après le 'Bonjour' et le tableau dessous.
Pour d'autre mise en forme ou mise en page, cela tient plus d'un forum Word qu'excel.
A vous d'apprendre comment insérer et déplacer la sélection dans word

Sub envoi_mail()
    Dim olk As Object, email As Object, wdDoc As Object
    Dim erreur As Integer
    Dim nb_lignes As Long 'Long et pas integer
    Dim rng As Object

    Dim plage As Range
    ' 1 - Définition de la plage à copiée
    With Sheets("Demande_validation_plan")
        Set plage = .Range("A1:G" & .Range("A1").End(xlDown).Row)
        nb_lignes = plage.Rows.Count
    End With

    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 = New Outlook.Application 'CreateObject("outlook.application")
    Set email = olk.CreateItem(olMailItem)

    With email
        '....... remplissage sujet, objet, et adresse
        .To = "xxxxx@yahoo.fr"
        .CC = ""
        .Subject = "Plans à valider"
        .bodyformat = 3 'olFormatRichText
        '....... corps du mail
                 .Display
       Set wdDoc = email.GetInspector.WordEditor
        
        Set rng = wdDoc.Range(0, 0)
        ' Insertion avant la copie du tableau
        rng.InsertAfter "Bonjour," & vbNewLine
        Set rng = rng.Paragraphs.Add().Range
        
         '
         ' Copie du tableau et insertion dans word
        plage.Copy
         rng.Paste

        rng.Move 4, -1
      
       ' Afficher le mail

        '....... 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

Bonne étude

 

[Staple1600]

Bonsoir le fil, PETIT YANNICK, Roblochon

Si il n'y avait que le WorkBook_Open()...
Moi, je reste sur l'absence de feedback du demandeur dans le précédent fil

https://www.excel-downloads.com/thr...asseur-excel-par-mail.20038183/#post-20273089

Discourtoisie ou inexpérience des fonctionnalités de recherche offerte par le forum

 

[PETIT YANNICK]

Bonsoir staple1600,

Je vous ai fait un retour de feedback un peu tardif c est vrai.

Je n ai pas eut le temps de faire un retour à votre reponse car entre temps j ai trouvé un bout de code qui copiait en format tableau et non en image . Suite à votre suggestion de continuer de chercher ce que j ai fait.

J ai ouvert une autre conversation car la demande n était plus tout à fait la même.

En tout cas merci à tous .

 

[riddick93]

Bonjour à toutes et tous,
Merci pour ces explications qui m'ont permis de créer mon envoi depuis excel.
En revanche je constate un léger soucis sur le mail envoyé.
Lorsque je scroll pour voir tous le contenu du mail arrivé vers la fin tout se décale et j'ai un grand blanc dans le mail mais pas mes informations.
Auriez vous une solution?
voici le code que j'ai utilisé:

Private Sub CommandButton2_Click()

Dim olk As Object, email As Object, wdDoc As Object
    Dim erreur As Integer
    Dim rng As Object

    Dim plage As Range
    ' 1 - Définition de la plage à copiée
    With Sheets("dashboard")
        Set plage = .Range("A7:BH88")
    End With

    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 = New Outlook.Application 'CreateObject("outlook.application")
    Set email = olk.CreateItem(olMailItem)

    With email
        '....... remplissage sujet, objet, et adresse
        .To = "x135055"
        .CC = ""
        .Subject = "Point de situation des indicateurs SAU ITA pour le " & Sheets("CONFIG").Range("$N$2").SpecialCells(xlCellTypeVisible).Value
        .BodyFormat = 3 'olFormatRichText
        '....... corps du mail
                 .Display
       Set wdDoc = email.GetInspector.WordEditor
       
        Set rng = wdDoc.Range(0, 0)
        ' Insertion avant la copie du tableau
        rng.InsertAfter "Bonjour, voici les indicateurs de la journée d'hier." & vbNewLine
        Set rng = rng.Paragraphs.Add().Range
        rng.InsertAfter "PDT: " & vbNewLine
        rng.InsertAfter "NOVA: " & vbNewLine
        rng.InsertAfter "TELEPHONIE: " & vbNewLine
        rng.InsertAfter "TCHAT: " & vbNewLine
        Set rng = rng.Paragraphs.Add().Range
         '
         ' Copie du tableau et insertion dans word
        plage.Copy
         rng.Paste

        rng.Move 1, -1
     
       ' Afficher le mail

        '....... 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