Copie plage de cellule dans un mail + classeur en PJ

Bonjour,

je cherche une solution afin de générer un mail contenant, dans le corps du message, une plage de cellules issue du classeur actif et de joindre ce même classeur au mail.

en gros je souhaiterai dans mon onglet, insérer un bouton cliquable afin de générer un mail outlook, par exemple, avec comme destinataire une adresse fixe, un objet dépendant d'une cellule A1 par exemple et un corps de mail issue de la plage de cellule A2:B30 et pour finir attacher le classeur entier au mail.

j'ai trouvé des bouts de code pour insérer des plages de cellule, d'autres pour attacher un mail mais jamais les deux ensemble.

merci d'avance si certains on déjà bossé sur un sujet similaire...

Nicolas

Bonjour Nicolas et bienvenue,

voici un exemple,

Sub SendRangeByMail()
Dim rngeSend As Range

With Application
    On Error Resume Next
    Set rngeSend = Sheets("Feuil1").Range(Range("A1").CurrentRegion.Address) 'à adapter
    If rngeSend Is Nothing Then Exit Sub
    sFile = Environ("Temp") & "\XLRange.htm"
    On Error GoTo 0
    .ActiveWorkbook.PublishObjects.Add(4, sFile, rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
    Call PrepareOutlookMail(sFile)
    Kill sFile
End With
End Sub

Sub PrepareOutlookMail(sFileName)
Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem

   Set appOutlook = CreateObject("Outlook.Application")
   If Not (appOutlook Is Nothing) Then
      Set oMail = appOutlook.CreateItem(olMailItem)
        With oMail
         .To = "Adresse@mail.fr"
         .Subject = "RELANCES A EFFECTUER"
         .HTMLBody = ReadFile(sFileName)
         .Attachments.Add (ThisWorkbook.FullName)
         .Display  'metre cette ligne en commentaire pour éviter l'affichage du mail
  '       .Send    'mettre cette ligne active pour l'envoi du mail sans qu'il soit affiché
        End With
      Set oMail = Nothing
      Set appOutlook = Nothing
   End If
End Sub

Public Function ReadFile(sFileName) As String
Dim fso As Object, fFile As Object
Dim sTemp As String
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fFile = fso.OpenTextFile(sFileName, 1, False)
   sTemp = fFile.ReadAll
   fFile.Close
   Set fFile = Nothing
   ReadFile = sTemp
End Function