VBA - Insérer un tableau croisé dynamique dans un mail

Bonjour,

J'ai un tableau croisé dynamique nommé "Surface" que je souhaite envoyer par mail après actualisation.

J'utilise outlook. voilà le code pour l'envoi que j'avais construit mais ça ne fonctionne pas.

Sub EnvoiSurface()

Sheets(1).Activate
Set rng = ThisWorkbook.Sheets(1).Range("Surface")

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

text1 = "Bonjour"
text2="Cordialement"

With OutMail
.to = "toto@mail.fr"
.Subject = "toto"
.htmlbody = Rangetohtml(rng)

.display
End With

End Sub

Comment est ce que je peux intégrer le tableau croisé dynamique dans le mail?

Merci d'avance

Agrimaman

Bien je ne pense pas que tu puisses le faire de tel en sorte qu'OutLook reconnaisse ton Tableau comme un TCD.

Toutefois, j'ai essayé de Copier coller un TCD dans un email Outlook, le résultat est plutôt tentant car Outlook le reconnait au moins en tant que tableau.
Si je dois rectifier ton code (NB : Je ne l'ai pas testé) cela donnerait ceci :

Sub EnvoiSurface()

On Error Resume Next
Sheets(1).Activate
Set rng = ThisWorkbook.Sheets(1).Range("Surface")
rng.Copy

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

text1 = "Bonjour"
text2="Cordialement"

With OutMail
.to = "toto@mail.fr"
.Subject = "toto"
.htmlbody = rng.Paste 'Rangetohtml(rng)

.display
End With

End Sub

Bref essaie !

Je pense aussi que .htlmbody tu peux le remplacer par

.Body

tout court

Bonjour,

Merci de ton retour. Par contre ça ne marche pas. En déroulant le code, après être passée sur la ligne

Set rng = ThisWorkbook.Sheets(1).Range("Surface")

quand je mets la souris sur rng, il me met rng=nothing. Donc il ne me copie rien du tout.

Agrimaman

Désolée, j'ai plutôt essayé de copier-coller un tableau ("ListObject") et non un TCD !

Avec un TCD, essaie ceci, sans conviction

Sub EnvoiSurface()
Dim pvt as PivotTable
On Error Resume Next
Sheets(1).Activate
Set pvt = ActiveSheet.PivotTables("Tableau croisé dynamique1")                 
'Nom ou Index de ton TCD
pvt.PivotSelect "", xlDataAndLabel, True

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

text1 = "Bonjour"
text2="Cordialement"

With OutMail
.to = "toto@mail.fr"
.Subject = "toto"
.Body = Selection.Paste

.display
End With
Err.Clear
set pvt = Nothing
End Sub

Bonjour,

J'ai testé la formule mais il ne copie pas le tcd dans le corps du mail.

au niveau de

.Body=Selection.Paste

il est en erreur

Agrimant