Insérer nouvelle ligne entre deux tableaux Excel dans un mail Outlook

Bonjour,

Je rencontre un soucis sous vba pour ajouter un saut de ligne entre deux tableaux excel afin de les séparer dans un mail Outlook.

Voici mon code :

Sub mail ()

Dim ObjOutlook As Object
Dim ObjMessage As Object
Dim ObjTexte As Object
Dim rng As Object
Dim DL As Range
Dim nb_lignes As Integer

Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.CreateItem(0)

With ObjMessage
.To = Worksheets("Extract UO").Cells(l, 61)
.cc = Worksheets("Extract UO").Range("AS2")
.Subject = "Bilan mai juin" & UserFormCreationBL.TextBox2.Value
.Attachments.Add (DossierPieceJointe & Worksheets("Extract UO").Cells(l, 55) & ".pdf")

Set ObjTexte = ObjMessage.GetInspector.WorEditor
Set rng = ObjTexte.Range(0, 0)

rng.InsertAfter "Bonjour " & Worksheets("Extract UO").Cells(l, 58) & "," & vbCrLf & vbNewLine

Set rng = rng.Paragraphs.Add().Range

DL = Sheets("Extract UO").Range("M" & Application.Rows.Count).End(xlUp).Row
If DL > 5 Then
Sheets("Extract UO").Range("K5:O" & DL).Copy
End If

rng.Paste
rng.Move 4, -1

'Saut de ligne ou nouveau paragraphe

'Copie nouveau tableau 

.Display
End With

Set ObjOutlook = Nothing
Set ObjMessage = Nothing
Set ObjTexte = Nothing

End Sub

Mon code marche très bien.

Mais quand j'insère le deuxième tableau, les deux tableaux sont unis j'ai l'impression et impossible de faire une fonction "entrer" pour les séparer.

Est-ce que quelqu'un aurait une idée de comment faire ?

Merci par avance.

GuiGui8731

Bonjour,

Ci-joint le code corrigé à adapter :

Sub mail()
Dim ObjOutlook As Object
Dim ObjMessage As Object
Dim ObjTexte As Object
Dim rng As Object
Dim DL%
Dim nb_lignes As Integer
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.CreateItem(0)
With ObjMessage
    .To = Worksheets("Extract UO").Cells(1, 61)
    .cc = Worksheets("Extract UO").Range("AS2")
    .Subject = "Bilan mai juin" & UserFormCreationBL.TextBox2.Value
    .Attachments.Add (DossierPieceJointe & Worksheets("Extract UO").Cells(l, 55) & ".pdf")
    .Body = ""
    .Display
End With
Set ObjTexte = ObjMessage.GetInspector.WordEditor
With ObjTexte
    .Range(0, 0).InsertAfter "Bonjour " & Worksheets("Extract UO").Cells(1, 58) & "," & vbCrLf & vbNewLine
    DL = Worksheets("Extract UO").Range("M" & Application.Rows.Count).End(xlUp).Row
    If DL > 5 Then
        Worksheets("Extract UO").Range("K5:O" & DL).Copy
    End If
    .Paragraphs(3).Range.Paste
    Worksheets("Extract UO").Range("K1:O1").Copy 'Range à adapter
    .Paragraphs(ObjTexte.Paragraphs.Count).Range.Text = vbNewLine
    .Paragraphs(ObjTexte.Paragraphs.Count).Range.Paste
End With
Set ObjOutlook = Nothing
Set ObjMessage = Nothing
Set ObjTexte = Nothing
End Sub

Cdlt,

Bonjour Ergotamine,

Merci pour ton aide. Ton code fonctionne parfaitement pour ce que je voulais faire.

En revanche je n'ai plus ma signature qui s'affiche à la fin de mon mail.

Saurais tu comment la rajouter à la fin s'il te plait ?

GuiGui8731

Bonjour,

Si j'ai bien compris la méthode (il existe peut être plus simple mais je ne sais pas) :

Sub mail()
Dim ObjOutlook As Object
Dim ObjMessage As Object
Dim ObjTexte As Object
Dim rng As Object
Dim DL%
Dim nb_lignes As Integer
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.CreateItem(0)
With ObjMessage
    '.To = Worksheets("Extract UO").Cells(1, 61)
    '.cc = Worksheets("Extract UO").Range("AS2")
    .Subject = "Bilan mai juin" '& UserFormCreationBL.TextBox2.Value
    '.Attachments.Add (DossierPieceJointe & Worksheets("Extract UO").Cells(1, 55) & ".pdf")
    .Display
End With
Set ObjTexte = ObjMessage.GetInspector.WordEditor
With ObjTexte
    .Range(0, 0).InsertAfter "Bonjour " & Worksheets("Extract UO").Cells(1, 58) & "," & vbCrLf & vbNewLine & vbNewLine
    DL = Worksheets("Extract UO").Range("M" & Application.Rows.Count).End(xlUp).Row
    If DL > 5 Then
        Worksheets("Extract UO").Range("K5:O" & DL).Copy
    End If
    .Paragraphs(3).Range.Paste
    Worksheets("Extract UO").Range("K1:O1").Copy 'Range à adapter
    .Paragraphs(6 * (DL - 4) + 4).Range.Text = vbNewLine & vbNewLine
    .Paragraphs(6 * (DL - 4) + 4).Range.Paste
End With
Set ObjOutlook = Nothing
Set ObjMessage = Nothing
Set ObjTexte = Nothing
End Sub

Bonjour Ergotamine,

Alors je rencontre un petit problème avec ta mise de macro.

Le premier tableau se copie bien mais le deuxième se copie à coté mais avec les valeurs placées à côté dans le désordre.

Avec le premier code les deux tableaux se copiaient bien l'un sous l'autre.

Y aurait-il une fonction qui permette d'appeler la signature qui est créée dans le répertoire ci-dessous après la copie du dernier tableau ?

Singature = "c:\...\HR.htm"

GuiGui8731

Bonjour,

Vous pouvez utiliser cette fonction avec le nom d'une des signatures enregistrées dans Outlook (onglet signature lors de la création d'un nouveau courrier)

Function Signature(nom_signature As String) As String
    Dim FSO As Object, TextStream As Object
    Dim nom_fichier As String

    Signature = Empty
    On Error Resume Next
    Set FSO = CreateObject("Scripting.FileSystemObject")
    nom_fichier = Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & ".htm"
    Set TextStream = FSO.OpenTextFile(nom_fichier)
    If Err.Num = 0 Then
        Signature = TextStream.ReadAll
        'remplacement adresse relative images par adresse absolue
        Signature = Replace(Signature, nom_signature & "_fichiers/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_fichiers/")
    End If
End Function

Bonjour thev,

Je place cette fonction dans vba d'accord.

Est-ce que je dois modifier la variable nom_signature dedans ou lui dire quel est le nom de la signature ?

Dois je appeler cette fonction à la fin de mon code quand mes deux tableaux sont collés ?

Merci d'avance

GuiGui8731

Bonjour,

1- vous recopiez la fonction dans un module

2- après collage de vos 2 tableaux, vous ajoutez l'instruction suivante :

With ObjTexte
    .Range(0, 0).InsertAfter "Bonjour " & Worksheets("Extract UO").Cells(1, 58) & "," & vbCrLf & vbNewLine & vbNewLine
    DL = Worksheets("Extract UO").Range("M" & Application.Rows.Count).End(xlUp).Row
    If DL > 5 Then
        Worksheets("Extract UO").Range("K5:O" & DL).Copy
    End If
    .Paragraphs(3).Range.Paste
    Worksheets("Extract UO").Range("K1:O1").Copy 'Range à adapter
    .Paragraphs(6 * (DL - 4) + 4).Range.Text = vbNewLine & vbNewLine
    .Paragraphs(6 * (DL - 4) + 4).Range.Paste

    .Content.InsertAfter vbNewLine & signature("nom")
End With 

où nom est l'une de vos signatures enregistrées dans Outlook.

Bonjour Thev,

J'ai bien ajouté le code signature dans un module et j'ai rajouté la ligne de code à la fin du mien.

La macro se déroule jusqu'au bout sans soucis mais la signature est composée de ligne html de la sorte :

<html xmlns:o="urn:schemas-microsoft-com:office:office"

Et cela sur une centaine de lignes. Savez vous d'où cela peut venir ?

GuiGui8731

Bonjour,

Avez-vous bien pris un nom de signature enregistré dans Outlook ?

menu Accueil --> nouveau courrier --> onglet : Joindre un fichier / Une signature --> Cliquer sur une signature --> signatures : les noms des signatures enregistrées apparaissent dans la fenêtre ouverte.

Bonjour,

La signature doit être de ce type :

Ou doit-elle être ainsi :

Il s'agit bien d'une signature enregistrée. Car dans le chemin des signatures sous microsoft ma signature existe en .htm et .txt

GuiGui8731

Donc

 .Content.InsertAfter vbNewLine & signature("Signature perso")

Voilà ce que j'obtiens à chaque fois en lançant la macro :

On dirait que VBA transforme la signature en html.

Faudrait il configurer vba en ajoutant une référence ou est-ce dans la fonction ?

GuiGui8731

        ObjMessage.HTMLBody = ObjMessage.HTMLBody & "<br/>" & "<br>" & Signature("signature perso")

Bonjour thev,

Ta ligne de code ajoute bien ma signature en fin de mail.

Mais le logo de ma société ne peut s'afficher correctement. Il y a le message d'erreur : nous ne pouvons pas afficher l'image.

Faut il déclarer dans le message .Htmlbody au lieu de .body ?

GuiGui8731

Bonjour Thev,

Effectivement j'ai remplacé l'espace dans le nom de la signature par un trait de soulignement et l'image apparaît correctement dans la signature.

Merci pour tout en tout cas.

GuiGui8731