Envoyer un tableau dynatique à plusieurs personnes par mail
Bonjour à tous,
je cherche une âme charitable pour un code VBA
J'ai sur une feuille Excel un tableau variant qui est sur les lignes 14 à 23.
Et j'ai en ligne 26 les adresses Email
Ce tableau varie avec la cellule C16
Ce que je voudrais, c'est envoyé un Email à chaque personne figurant sur la ligne 26.
Ce qui doit figurer le mail, c'est une pièce jointe du tableau et un aperçu du tableau.
Bien à vous
Bonjour Domtous,
Voici le fichier modifié avec le code pour envoyer une pièce jointe et un aperçu du tableau
J'espère que la solution vous conviendra
Bonjour JExceL2fr,
tout d'abord merci de t'être penché sur mon problème,
je viens d'effectuer un premier test, seulement une seule personne reçoit le mail et le tableau n'est pas à la bonne taille.
bien à vous
J'ai demandé à Copilot pour un petit code VBA et après plusieurs demandes il m'a envoyé cela, le code fonctionne, sauf que le tableau envoyé n'est pas vraiment comme je le vaudrais. il faudrait qu'il ne comporte que les colonnes ayant un rapport avec les mails envoyés.
Option Explicit
' Définir l'objet pour tout le module
Dim Ws As Worksheet
Sub Envoi_Planning_par_Mail()
Dim OutApp As Object, OutMail As Object
Dim strbody As String, MakeJPG As String
Dim Cell As Range, Destinataires As Range, LastCol As Integer, FirstCol As Integer
Dim tableRange As Range ' Définir la variable tableRange
' Définir la feuille avec laquelle on va travailler
Set Ws = ThisWorkbook.Sheets("A imprimer par groupe")
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
' Définir la dernière colonne non vide dans la ligne 26 pour les adresses e-mail
LastCol = Ws.Cells(26, Ws.Columns.Count).End(xlToLeft).Column
FirstCol = 4 ' Colonne D
' Créer la plage des destinataires (de la colonne D26 à la dernière colonne non vide)
Set Destinataires = Ws.Range(Ws.Cells(26, FirstCol), Ws.Cells(26, LastCol))
' Boucle à travers les colonnes des destinataires pour éliminer les colonnes vides
Dim col As Integer
For col = LastCol To FirstCol Step -1
If Application.WorksheetFunction.CountA(Ws.Range(Ws.Cells(26, col).Address)) = 0 Then
Ws.Columns(col).Delete
End If
Next col
' Redéfinir la plage du tableau dynamiquement (A14 à colonne correspondant au nombre de destinataires)
LastCol = Ws.Cells(26, Ws.Columns.Count).End(xlToLeft).Column
Set tableRange = Ws.Range(Ws.Cells(14, 1), Ws.Cells(23, LastCol))
' Créer l'image d'une plage
MakeJPG = CopyRangeToJPG(Ws, tableRange.Address)
' En cas d'erreur
If MakeJPG = "" Then
MsgBox "Il y a eu un souci pour la création de l'image, impossible de continuer !", vbCritical, "OUPS..."
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
End If
' Créer une instance Outlook pour envoyer un e-mail
Set OutApp = CreateObject("Outlook.Application")
' Boucle à travers chaque cellule de la plage des destinataires
For Each Cell In Destinataires
' Vérifier que la cellule n'est pas vide
If Cell.Value <> "" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cell.Value
.CC = ""
.BCC = ""
.Subject = "Planning de la semaine : " & Ws.Range("C14").Value
.HTMLBody = "<html>Bonjour,<br><br>Vous trouverez ci-joint et ci-dessous le planning de la semaine<br><br>" _
& "<p>" & strbody & "</p><img src=""cid:NamePicture.jpg""><br><br>Cordialement.</html>"
.Attachments.Add MakeJPG
.Send ' Utilisez .Display si vous souhaitez voir le mail avant envoi
End With
On Error GoTo 0
End If
Next Cell
Kill MakeJPG
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Private Function CopyRangeToJPG(WsSource As Worksheet, RangeAddress As String) As String
Dim PictureRange As Range
On Error Resume Next
WsSource.Activate
Set PictureRange = WsSource.Range(RangeAddress)
PictureRange.CopyPicture
With WsSource.ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("TEMP") & Application.PathSeparator & "NamePicture.jpg", "JPG"
End With
WsSource.ChartObjects(WsSource.ChartObjects.Count).Delete
CopyRangeToJPG = Environ$("TEMP") & Application.PathSeparator & "NamePicture.jpg"
Set PictureRange = Nothing
End Function