Insérer Tableau Excel dans Corps d'un message mail

[judisant]

Bonjour,

Je viens vers vous pour une question autour d'une macro où je voudrais insérer un tableau Excel dans le corps du message (et en pièce jointe).

Après application de macros, il me reste un tableau que je mets dans un répertoire, puis que j'envoie par mail avec en pj le tableau Excel, un intitulé pré-formaté (texte + date du jour + entête) et un texte pré-formaté également. La tableau compte le nombre de case vide dans une colonne, ce qui donne un texte dans le corps du message.

Ce que je voudrais faire, c'est mettre en brut le tableau Excel directement dans corps du message Excel, comme ca les personnes qui recevront le tableau verront tout de suite s'ils sont concernés par le message et ouvriront ensuite la pièce jointe pour compléter le tableau ou mettre des commentaires.

Pour l'instant j'ai ce code qui marche très bien. J'ai juste remplacé des textes par des "xxxx".

Ma question est : est-ce que ma requête est possible (sachant que le tableau n'est pas fixe au niveau du nombre de ligne, le nombre de colonne est OK, il faudrait avoir un code pour délimiter naturellement le tableau) et facilement insérable dans ce code pour qu'en un seul bouton 'envoi mail', je puisse à la fois mettre tout le code ci-dessous ET le tableau d'excel en brut (ou print écran du tableau uniquement pas de toute la page).

Je ne suis pas spécialiste du tout... un grand merci pour votre aide !

Macro envoie mail :

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook xxx.x Object Library"
Sub Envoi()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim Strbody As String
Dim HTLMbody As String
Dim Mess As String
Dim DateJour As Date
Dim jour As String
Dim mois As String
Dim annee As String
Dim Chemin1 As String
Dim PJ1 As String
Dim Message As String
Dim Lien As String
Dim compteur_new As Integer

Sheets("SUSPENS").Activate
Range("i27").Activate
compteur_new = 0
Do
If ActiveCell.Value = 0 Then
compteur_new = compteur_new + 1
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Offset(0, -8).Value = 0

DateJour = Date
jour = Day(DateJour)
mois = Month(DateJour)
annee = Year(DateJour)

If jour < 10 Then
jour = "0" & jour
End If
If mois < 10 Then
mois = "0" & mois
End If

'Message = "Bonjour,<BR><BR>Vous trouverez ci-dessous le lien vers le tableau xxxxxx: <BR><A HREF='x:\xxxx\xxxxx\xxxxxxx'>x:\xxxxxx\xxxxx\xxxxx\xxxxx\xxxxxxxxx</A>"
Message = "Bonjour,<BR><BR>Vous trouverez ci-dessous le lien vers le fichier du tableau des xxxxxx : <BR><A HREF='x:\xxxxx\xxxx\xxxxxxxxx\xxx\xxxxxx\'>x:\xxxx\xxxx\xxxxxxxx\xxxxx\xxxxx\</A>"
If compteur_new > 0 Then
Message = Message & "<BR><BR><B><BIG><FONT COLOR=RED>Attention, " & compteur_new & " xxxxx en vie.</FONT></B></BIG>"
Else
Message = Message & "<BR><BR><B><BIG>Aucun xxxxxx en vie ce jour.</B></BIG>"
End If
Message = Message & "<BR><BR>Bonne journée."




Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
'Exemple pour envoyer un classeur en pièce jointe
'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
'Ou bien entrer le path et nom du fichier autrement
Nom_Fichier = "C:\Documents and Settings\xxxxx\Desktop\Projet_tableau_xxxxxxx.xls"
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
With oBjMail
.Display
.To = "xxxxx@xxxx.com" ' le destinataire
.CC = "xxxxxxx@xxxxxx.com" 'en copie du mail
.Subject = "Tableau xxxxxx du " & jour & "/" & mois & "/" & annee
.HTMLBody = Message + .HTMLBody
'le corps du mail ..son contenu
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
'send si envoi manuel'
End With
'Si tout fermer sans verification
'ObjOutlook.Quit
'Set oBjMail = Nothing
'Set ObjOutlook = Nothing

End Sub


Un grand merci !

Judisant

 

[don_pets]

Re : Insérer Tableau Excel dans Corps d'un message mail

Bonjour,

tu pourrais partir sur truc comme ça :

ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
.Introduction = "Ici tu rentres le texte que tu veux"
.Item.To = "mail@machin.com;"
.Item.Subject = "Ton titre"
.Item.Send
End With

L'idée c'est qu'il va regarder la colonne A de la feuille active (à adapter), et qu'il va regarder la dernière ligne remplie, et va le coller en corps de texte dans ton mail.

Après encore une fois, c'est une idée générale, à adapter à ton cas.

Tao pai pai

pets

 

[judisant]

Re : Insérer Tableau Excel dans Corps d'un message mail

Salut Don_pets,

Merci pour ton aide ! J'ai essayé la macro mais elle ne fonctionne pas où je la place au mauvais endroit dans le code que j'ai mis plus haut. Dans ton code, je comprend ou je dois me mettre mais apres remettre les adresses mails, mon code le fait deja du coup, soit je m'adapte totalement au tien ou bien je l'adapte à mon code mais je vois pas comment (j'ai deja un end with avec mon code). Tu le positionnerais ou le code dans le mien (j'ai des erreur de compilation ou des débogages intempestifs)...

Judisant

 

[don_pets]

Re : Insérer Tableau Excel dans Corps d'un message mail

ok je regarde soir ce tranquillou

 

[david84]

Re : Insérer Tableau Excel dans Corps d'un message mail

Bonsoir,
voir ici ou le site de Ron De Bruin par exemple.
A+

 

[judisant]

Re : Insérer Tableau Excel dans Corps d'un message mail

Bonjour David,

Tes liens sont supers, je comprends ce qui est écrit mais je n'arrive toujours à l'adapter à mon code (visible ci-dessus). J'incrémente déjà des compteurs et un message prédéfini + un autre code pour une codification pour la date mais pour assembler mon code avec ce qui est proposé, soit ca bug complètement ou soit je ne vois aucun changement...

Mon travail utilise déjà ces codes, j'ai mis le fichier en pièce jointe si ca peut aider (le tableau varie en nombre de lignes en fonction des ajouts, seuls le nombre de colonne de bouge pas et les entêtes naturellement), l'idée est de copier ce tableau (qui peut bouger de temps à autre) directement dans le mail tout en conservant le reste du codage et les autres macros.

Après je suis hyper débutant en la matière, je pense qu'il faut juste insérer des bouts de ces codes dans le miens mais pas fort en tétris...

Un grand merci à ceux qui arrivent à m'aider

 

[judisant]

Re : Insérer Tableau Excel dans Corps d'un message mail

Bonjour,

J'ai enfin pu assembler les code après recherches et prise de tête !

Mais se pose un seul souci, c'est la plage sélection, c'est à dire la fonction set range. Je pense que ca peut passer par une boucle avec le disant. C'est à dire que je commence dans un cellule et que ca descent d'une cellule tant que ya du texte. Une fois que ya plus de texte je prends la plage où à eu lieu la boucle avec un nombre de colonnes défini à l'avance.

Pour l'instant j'ai ça comme code :

Sub envoi()
'For Tips see: Excel Automation - Ron de Bruin
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2013
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim Strbody As String
Dim HTLMbody As String
Dim Mess As String
Dim DateJour As Date
Dim jour As String
Dim mois As String
Dim annee As String
Dim Chemin1 As String
Dim PJ1 As String
Dim Message As String
Dim Lien As String
Dim compteur_new As Integer

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'uniquement les cellules sélectionnés (à optimiser)
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'plage fixe
Set rng = Sheets("SUSPENS").Range("A410:H26").SpecialCells(xlCellTypeVisible) On Error GoTo 0

If rng Is Nothing Then
MsgBox "La sélection n'est pas une plage ou la feuille est protégé" & _
vbNewLine & "corriger et recommencer.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Sheets("SUSPENS").Activate
Range("i27").Activate
compteur_new = 0
Do
If ActiveCell.Value = 0 Then
compteur_new = compteur_new + 1
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Offset(0, -8).Value = 0

DateJour = Date
jour = Day(DateJour)
mois = Month(DateJour)
annee = Year(DateJour)

If jour < 10 Then
jour = "0" & jour
End If
If mois < 10 Then
mois = "0" & mois
End If

'Message = "Bonjour,<BR><BR>Vous trouverez ci-dessous le lien vers le tableau xxxxxx: <BR><A HREF='x:\xxxx\xxxxx\xxxxxxx'>x:\xxxxxx\xxxxx\xxxxx \xxxxx\xxxxxxxxx</A>"
Message = "Bonjour,<BR><BR>Vous trouverez ci-dessous le lien vers le fichier du tableau des xxxxxx : <BR><A HREF='x:\xxxxx\xxxx\xxxxxxxxx\xxx\xxxxxx\'>x:\xxxx \xxxx\xxxxxxxx\xxxxx\xxxxx\</A>"
If compteur_new > 0 Then
Message = Message & "<BR><BR><B><BIG><FONT COLOR=RED>Attention, " & compteur_new & " xxxxx en vie.</FONT></B></BIG>"
Else
Message = Message & "<BR><BR><B><BIG>Aucun xxxxxx en vie ce jour.</B></BIG>"
End If
Message = Message & "<BR><BR>Bonne journée."




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'---------------------------------------------------------
'Exemple pour envoyer un classeur en pièce jointe
'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
'Ou bien entrer le path et nom du fichier autrement
Nom_Fichier = "C:\Documents and Settings\jthialon\Desktop\Projet_tableau_des_suspens.xls"
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------

On Error Resume Next

With OutMail
.Display
.To = "julien.thialon@am.natixis.com"
.CC = "julien.thialon@am.natixis.com"
.BCC = ""
.Subject = "Tableau des suspens du " & jour & "/" & mois & "/" & annee
.HTMLBody = Message + RangetoHTML(rng) + .HTMLBody
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
'.send si envoi direct


End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function


C'est le code en gras et souligné qui pose souci....

 

[david84]

Re : Insérer Tableau Excel dans Corps d'un message mail

Bonjour,
je n'ai pas testé ton code mais la sélection de ta plage

Range("A410:H26")

me semble suspecte.
A+

 

[judisant]

Re : Insérer Tableau Excel dans Corps d'un message mail

Oui, c'est moi qui l'ai mis manuellement car je ne sais pas comment faire avec une boucle d'où mon interrogation.

En gros sur ce code, je voudrais faire une boucle qui descend d'une cellule tant qu'elle n'est pas vide et une fois qu'il en rencontre une, que cela me sélectionne la plage de la première à la dernière cellule testé et d'y inclure une colonne défini à l'avance. Ceci dans le but de ne pas figer le tableau qui bougera de toute facon quotidiennement en fonction de mes ajouts.

Exemple : un tableau de A1 à B40
Boucle démarrant en A1 et s'arrêtant à A40(dernière cellule non vide) et qu'il me sélectionne automatiquement la place A1 a B40 (peu importe que la colonne B soit remplie)

 

[david84]

Re : Insérer Tableau Excel dans Corps d'un message mail

Exemple : un tableau de A1 à B40
Boucle démarrant en A1 et s'arrêtant à A40(dernière cellule non vide) et qu'il me sélectionne automatiquement la place A1 a B40 (peu importe que la colonne B soit remplie)

Je n'ai pas testé sur ton tableau car pas assez clair mais un exemple parmi d'autres :

Sub PremCelluleNonVide()
Dim DerLig As Long, Plage As Range
'DerLig = Range("A" & Rows.Count).End(xlUp).Row '1ère ligne non vide en partant de la dernière cellule de la colonne A
DerLig = Range("A1").End(xlDown).Row '1ère ligne non vide en partant de A1
Set Plage = Range("A1:B" & DerLig)
MsgBox Plage.Address
End Sub

A+

 

[Roland_M]

Re : Insérer Tableau Excel dans Corps d'un message mail

bonsoir

à tout hasard !?
voir ce classeur qui pourrait faire affaire !?

 

[judisant]

Re : Insérer Tableau Excel dans Corps d'un message mail

Je n'ai pas testé sur ton tableau car pas assez clair mais un exemple parmi d'autres :

Sub PremCelluleNonVide()
Dim DerLig As Long, Plage As Range
'DerLig = Range("A" & Rows.Count).End(xlUp).Row '1ère ligne non vide en partant de la dernière cellule de la colonne A
DerLig = Range("A1").End(xlDown).Row '1ère ligne non vide en partant de A1
Set Plage = Range("A1:B" & DerLig)
MsgBox Plage.Address
End Sub

A+

J'ai adapté ton code au mien (galéré une heure pour une ligne de code !) mais ca fonctionne nickel !

Je vais pouvoir désormais m'atteler à une autre problématique

Grand merci à tous !

PS : Roland, ton code est monstrueux Mais la plapart des envoi me verrouillent mon ordinateur je ne sais pas comment...

 

[Roland_M]

Re : Insérer Tableau Excel dans Corps d'un message mail

bonjour,

qu'appels tu "verrouillent" ? c'est impossible en l'état !!!

de plus ce n'est pas la première fois que je le diffuse et toutes les personnes qui l'utilisent sont très satisfaites !

ça ne serait pas plutôt une référence manquante ?
genre: Microsoft CDO for Windows 2000 Library