Transfomer un tableau en image
bonjour à tous,
voici mon problème, j'ai effectuer l'automatisation de l'envoi d'un planning par mail chaque semaine, pour cela je copie le planning qui est sous forme de tableau et je le copie dans le mail que j'envoie.
cette solution fonctionne bien sur ordinateur, cependant, je me suis rendu compte que les téléphones ne sont pas capable de lire ce tableau, ce qui donne une suite de caractère sans aucun sens.
existe t-il une solution pour transformer le tableau en image.
voici, si joint, mon code vba
Sub envoie_mail()
ActiveCell.Range("A1:P32").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "bonjour , ci joint le planning pour la semaine du " & Date
.Item.To = "exemple@gmail.com"
.Item.Subject = "planning semaine du" & Date
.Item.Send
End With
End Sub
merci pour votre aide.
Maxime
Bonjour,
Voilà une solution.
Sub Macro2()
Range("A1:F12").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Range("I1").Select
ActiveSheet.Paste
End Sub
Cdt.
non, cette solution ne fonctionne pas, le téléphone considère toujours que le corps est un tableau...
en effet, le tableau est bien transformé en image, cependant, c'est toujours la selection effectuée avant qui est envoyée
non, cette solution ne fonctionne pas, le téléphone considère toujours que le corps est un tableau...
en effet, le tableau est bien transformé en image, cependant, c'est toujours la selection effectuée avant qui est envoyée
Tu doit d'abord, sauvegardé l'image coller sur une autre feuille, avant de la prendre et la mettre dans le corps de ton mail.
Tu pourras ensuite la supprimer.
re, j'ai essayer ce que tu m'as dit, je pense que c'est une solution qui peut fonctionner mais il reste un problème...
lorsque je reçois le mail, l'image n'est qu'une sélection vide...
voici un screen ainsi que le nouveau code
Sub envoie_mail()
ActiveCell.Range("A1:P32").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Sheets("Feuil1").Select
ActiveSheet.Paste
Selection.Name = "planning"
ActiveSheet.Shapes.Range(Array("planning")).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "bonjour , ci joint le planning pour la semaine du" & Date
.Item.To = "maxime.charron4@gmail.com"
.Item.Subject = "le sujet"
.Item.Send
End With
Selection.Delete
End Sub
Je ne vois pas de body dans ton code.
Alors il te faut mettre l'image en pièce jointe.
je suis désolé, le sujet s'éternise je pense pour pas grand chose mais je n'arrive pas à mettre l'image que ce soit dans le body ou bien en pièce jointe (je préférerai d'ailleurs la mettre dans le body si possible).
j'ai écumé les forum existant et il y a plusieurs solutions pour joindre un fichier externe en pièce jointe mais rien qui ne permet d'envoyer une image déjà présente dans excel
Bonjour,
Tu as du bol !!!
Après beaucoup d'acharnement je pense avoir trouver une solution pour toi.
Sub View_Email632()
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'File path/name of the gif file
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
ThisWorkbook.Sheets("CC").Range("A1:F12").CopyPicture xlScreen, xlBitmap
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
'.Delete
End With
On Error Resume Next
With OutMail
.To = "a.bitty@wafacash.cm"
.CC = ""
.BCC = ""
.Subject = "Le sujet"
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg"">"
.display
.Send
End With
'Delete the gif file
Kill Fname
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Cordialement.
je suis vraiment désolé mais j'ai à peu près compris ton code alors j'ai tenté de l'adapté à ma situation mais il m'envoie chier disant qu'il ne connais pas "chart".
je suis alors revenu aux bases en partant de ton code, et même là, je ne reçois qu'une image blanche...
je ne comprend pas pourquoi il n'est pas possible de simplement coller l'image depuis le presse papier dans le corps mais qu'on soit obligé de l'exporter pour ensuite le réimporter, c'est stupide...
Ok, j'ai réussi à faire "fonctionner le code" ce qui est un grand mot, maintenant, il prends en compte le tableau mais prend les valeurs qui sont dans une case qui n'a aucun rapport, créer un diagramme en barre avec et l'envoie par mail...
j'avoue ne plus savoir quoi faire, voici ton code adapté:
Sub envoie_mail()
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
ActiveCell.Range("A1:P32").Select
Selection.CopyPicture xlScreen, xlBitmap
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
End With
On Error Resume Next
With OutMail
.To = "maxime.charron4@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Le sujet"
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg"">"
.Display
.Send
End With
Kill Fname
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
End Sub
Bonsoir,
Que l'on se comprenne bien.
1) Le mails est envoyer par outlook.
2) Le fichier est bien enregistré quelque part.
3) La section sélectionné commence bien par une cellule non vide.
si cela est le cas, bien vouloir respecté l'agencement.
La copie doit s’enclencher un instant avant la création du "Chart"/Graphique.
Si la cmde créer le graphique avant de copié..... Cela veut dire que tu ne suis pas la démarche normale.
Aussi, rassure toi d'avoir ta feuille active avant l’exécution de la macro.
Sub View_Email632()
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'File path/name of the gif file
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
ThisWorkbook.Sheets("CC").Range("A1:P32").CopyPicture xlScreen, xlBitmap
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
'.Delete
End With
On Error Resume Next
With OutMail
.To = "a.bitty@wafacash.cm"
.CC = ""
.BCC = ""
.Subject = "Le sujet"
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg"">"
.display
.Send
End With
'Delete the gif file
Kill Fname
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Cordialement.
en effet, les trois conditions sont réspéctées, voici le fichier que j'utilise.
d'ailleurs, quand je fais les étapes "dans le bon ordre", le débogger me sort une erreur 91 avec le with
Bonsoir,
Trouve ci-dessous un code qui te permet de sélectionner une zone aléatoire de ton classeur et l'exporte.
NB : Si tu peux mettre le fonds blanc dans les cellules sa aide à masquer le graphique avec les chiffres qui est généré derrière.
Sub View_Email632()
'***************
Dim rng As Range
Dim DefaultRange As Range
Dim FormatRuleInput As String
If TypeName(Selection) = "Range" Then
Set DefaultRange = Selection
Else
Set DefaultRange = ActiveCell
End If
On Error Resume Next
Set rng = Application.InputBox( _
Title:="Première case du taleau", _
Prompt:="Select a cell range to begin copy", _
Default:=DefaultRange.Address, _
Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
rng.Select
Selection.CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture
'***************
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
ActiveChart.PlotArea.ClearFormats
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
End With
On Error Resume Next
With OutMail
.To = "a.bitty@wafacash.cm"
.CC = ""
.BCC = ""
.Subject = "Le sujet"
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg"">"
.display
.Send
End With
Kill Fname
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Cordialement.