Ajouter du texte après l'insertion de contenu issu d'un fichier Excel

Bonjour à tous,

J'ai ce code VBA qui fonctionne bien, mais je ne parviens pas à insérer du texte en début de mail. La fonction .body est comme écrasée par le collage de contenu Excel.

L'un sans l'autre fonctionne sans souci.

Merci pour votre aide et voici le code :

Sub Envoyer_Copie_IMAC_UO()
    Dim OutlookApp As Outlook.Application
    Dim OutlookMail As Outlook.MailItem
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim rng1 As Range, rng2 As Range, rng As Range
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("IMAC (ATJ+UO)")
    Set rng1 = ws.Range("A4:J10")
    Set rng2 = ws.Range("A17:J31")
    Set rng = Union(rng1, rng2)
    rng.Copy
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(olMailItem)
    With OutlookMail
        .Subject = "FAC - MOIS"
        .To = "test@mail.com"
        .Body = "Commentaires" & vbNewLine
        .GetInspector.WordEditor.Range.Paste
        .Display
    End With
End Sub

Bonjour,

Qu'est-ce que tu cherches à mettre dans le corps de ton message ?

Daniel

Par exemple :

Bonjour XX,

Ci-dessous le tableau YY concernant ZZ.

Cordialement,

J'ai également tenté cette variante, mais idem :

'Ajouter le contenu de la plage de cellules sous forme de texte dans une variable
sCommentaires = "Commentaires :" & vbNewLine & rng.Text

[...]

 .Body = sCommentaires & vbNewLine & vbNewLine 'Ajouter les commentaires à la propriété Body de l'email

J'ai l'impression que la fonction "'.GetInspector.WordEditor.Range.Paste" Ecrase l'ensemble des élements qui figurent avant ou après...

Je dois trouver un moyen de conserver mon commentaire issu de .Body sans que .GetInspector.WordEditor.Range.Paste n'écrase le tout ensuite.

J'ai l'impression que la fonction "'.GetInspector.WordEditor.Range.Paste"

Je ne connais pas cette instruction. Elle écrase tout, mais j'ai essayé sans succès :

.GetInspector.WordEditor.Range.InsertAfter

sans succès. Essaie cette autre façon :

Sub Envoyer_Copie_IMAC_UO()
  Dim ws As Worksheet
  Dim wb As Workbook
  Dim rng1 As Range, rng2 As Range, rng As Range
  Set wb = ThisWorkbook
  Set ws = wb.Sheets("IMAC (ATJ+UO)")
  ws.[A33] = "Cordialement"
  Set rng1 = ws.Range("A4:J10")
  Set rng2 = ws.Range("A17:J33")
  Set rng = Union(rng1, rng2)
  rng.Select
  ActiveWorkbook.EnvelopeVisible = True
  With ActiveSheet.MailEnvelope
  .Item.To = "test@mail.com"
  .Item.Subject = "FAC - MOIS"
'  .Item.Send
  End With
End Sub

Daniel

Ce modèle intègre l'intégralité de la feuille excel. Ce n'est hélas pas mon attente.

En somme, je souhaite récupérer une partie de ma feuille Excel, d'où l'utilisation de

Set ws = wb.Sheets("IMAC (ATJ+UO)")
    Set rng1 = ws.Range("A4:J10")
    Set rng2 = ws.Range("A17:J31")
    Set rng = Union(rng1, rng2)
    rng.Copy

Transposer ces élements dans le corps du mail tout en permettant de préparer le mail ayant déjà précomplété le destinataire, l'objet et l'introd du mail d'ou la présence de

.Subject = "FAC - MOIS"
        .To = "test@mail.com"
        .Body = "Commentaires" & vbNewLine

Le blocage s'opère effectivement sur l'écrasement de l'ensemble des données préfigurant dans le mail, par les données issues de la feuille Excel...

C'est exact, et pourtant, le code devrait fonctionner. Un bug Excel 365 ?

Daniel

D'après mes nombreuses recherches, non c'est tout à fait normal.

L'utilisation d'un "InsertAfter" est censé fonctionné mais pas avec du contenu issu d'un fichier Excel contenant des tables.. Hélas.

Bon finalement, aidé par ChatGPT j'ai trouvé la solution !

Elle reside en le fait de d'abord définir les zones à copier avec :

    Set rng1 = ws.Range("A4:K10")
    Set rng2 = ws.Range("A14:K27")
    Set rng = Union(rng1, rng2)

puis de le coller dans le corps du mail à l'aide d'un doc word intermédiaire (WordEditor - transparent lors de la réalisation) qui y ajoutera non seulement du texte (libre) mais également les ranges copiés :

Set wordDoc = OutlookMail.GetInspector.WordEditor
Set wordSel = wordDoc.Windows(1).Selection

wordSel.TypeText "Bonjour XXX,"
wordSel.MoveDown
wordSel.TypeParagraph
wordSel.TypeText "Voici les éléments :"
wordSel.TypeParagraph
wordSel.MoveDown
wordSel.TypeParagraph
wordSel.Range.Paste
wordSel.MoveDown

Et je termine par faire compléter les champs du mail comme le destinataire et l'objet du mail,

With OutlookMail
.To = "name1@mail.com "
.CC = "name2@mail.com"
.Subject = "Réunion du xx/xx/xxx"
.Display
End With

Puis je purge le tout :

    Set wordDoc = Nothing
    Set wordSel = Nothing
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    

Si ca peut en aider certain ;)