Transfomer un tableau en image

Le 16/10/2019 à 09:28

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

Le 16/10/2019 à 09:41

Bonjour,

Voilà une solution.

Sub Macro2()

    Range("A1:F12").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("I1").Select
    ActiveSheet.Paste

End Sub

Cdt.

6copie-tableau.zip (10.97 Ko)
Le 16/10/2019 à 09:43

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

Le 16/10/2019 à 09:50
Inobody a écrit :

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.

Le 16/10/2019 à 10:20

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

sans titre
Le 16/10/2019 à 10:26

Je ne vois pas de body dans ton code.

Alors il te faut mettre l'image en pièce jointe.

Le 16/10/2019 à 11:14

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

Le 16/10/2019 à 13:41

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.

6copie-tableau.zip (11.67 Ko)
Le 16/10/2019 à 13:57

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...

Le 16/10/2019 à 14:48

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

Le 16/10/2019 à 15:45

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.

Le 16/10/2019 à 15:48

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

5planning-chantier-pour-forum.xlsm (648.41 Ko)
Le 16/10/2019 à 17:31

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.

51planning-chantier-pour-forum.xlsb (528.25 Ko)
Rechercher des sujets similaires à "transfomer tableau image"