Coller l'image de cellules Excel dans un mail Outlook (2016)

Version imprimable

Bonjour le Forum,

(mes excuses pour cette absence, débordé)

Je crée un objet Outlook dans lequel je veux insérer une image de quelques cellules de mon classeur.

Pour ce faire,
Exportation des cellules en ".png"
Utiliser le presse-papier pour coller l'image ainsi créée dans mon mail
Sur Excel 2010, j'arrivais à simuler CTRL+V par la méthode

Code:

SendKeys

Sur Excel 2016, échec : la ligne de code est inactive
Manuellement, si j'effectue CTRL+V, le presse-papier est bien actif et la copie sur le mail se réalise très bien.

Y aurait-il un élément de changé sur Excel 2016?

PS : la méthode HTMLBODY fonctionne mais je cherche à savoir.

Création Outlook

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
 
Sub Envoi_Documents()
'Utilise la liaison anticipée
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
 
With Worksheets("Mail")
        .Visible = True
        .Select
End With
 
Application.ScreenUpdating = True
 
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
 
With MonItem
 
        .To = "marcel@citron.fr"
        .Subject = "Coucou"
        .Display
 
        'copie du corps de texte dans le corps de message
        Call Exporte_img
 
        AppActivate "Coucou - Message", 0   ' Active Outlook
        SendKeys "^V", True  ' coller
        .Send
 
End With
 
Application.CutCopyMode = False
Set MonItem = Nothing
 
Set Applic_Outlook = Nothing
 
End Sub

Exportation des cellules en image

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Exporte_img()
 
Dim cells_img As Range
Dim export_img As Variant
 
Dim S As Shape
 
export_img = "lechemin\image.png"
 
 
With Worksheets("Mail")
 
        .Visible = True
        .Select
 
        On Error Resume Next
        For Each S In .Shapes
                S.Delete
        Next S
        On Error GoTo 0
 
        Set cells_img = .Range("corps_3")
 
        Application.Goto reference:="R1C105"
 
        ' Création d'une zone de graphique (de type histogramme, mais vide de toute façon...) et sélection de celle-ci
        .Shapes.AddChart2(201, xlColumnClustered).Select
        ' Redimentionnement à la taille de la zone de cellules
        .Shapes(1).Height = cells_img.Rows.Height * 2
        .Shapes(1).Width = cells_img.Columns.Width * 2
 
 
        .Shapes(1).ScaleWidth 0.5, msoFalse
        .Shapes(1).ScaleHeight 0.5, msoFalse
 
        ' Copier la zone de cellules sous forme d'image
        cells_img.CopyPicture xlScreen, xlPicture
        ' Collage dans la zone de graphique
        ActiveChart.Paste
 
        ' Export sous forme d'image
        ActiveChart.Export FileName:=export_img, FilterName:="PNG"
 
        ' Retour à la normale
        .Shapes(1).Delete
 
End With
 
End Sub

Par avance, merci pour vos retours

30/08/2017, 13h05
patricktoulon

re

Bonjour marcelG effectivement ca faisait un moment

pour ton sendkeys il te faut pas utiliser application.sendkeys mais d'abords créer un wscript.shell et de lui lancer les sendkeys

car application les sendkey sont vallable que dans l'application excel

pour les soucis d'activation de fenêtre application/Outlook je ne pourrais pas t'aider je n'utilise absolument pas l'application Outlook de Microsoft je préfère l'application web

il faut savoir que quand tu copie une plage et que tu la colle dans ton body ce qui est coller est une table html pas besoins de passer par une image a moins que pour des raisons de sécurité afin que les données ne puissent pas être modifiées par le destinataire tu prefaite une image

dans ce cas la c'est plage .copy
tu fait un premier paste
tu copy le dernier shape qui est en fait la copie en image puis delete et tu la paste dans le body du message

pas besoins de passer par un fichier image intermédiaire
30/08/2017, 13h17
Invité

Bonjour marcelG,
je t'invite à rédiger ton message en HTML (BodyHtml) et d'ajoute ton image en pièce jointe "c:\monRem\TOTO.PNG"

"<td valign='middle'><b><img src='TOTO.PNG'>"

re
oui robert mais ca représente un upload

tandis qu'un paste te mettra l'image en base 64 dans le body (pas d'upload) et SVP le code 64 de chez Microsoft hein robert;)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub test() plagecopy_in_picture Sheets(1).Range("A1:C4") End Sub Function plagecopy_in_picture(rng) rng.CopyPicture xlScreen, xlBitmap activesheet.Paste With ActiveSheet .Shapes(.Shapes.Count).Copy .Shapes(.Shapes.Count).Delete' on a pas besoins de grader l'image sur le sheets End With End Function
reste plus qu'a paster sur le bodyhtml

30/08/2017, 16h45
MarcelG

Paste dans objet Outlook
Salut Patrick,

C'est toujours un plaisir.

Source:copier image dans Outlook
Code:

1 2 3 4 Dim édit_ol Set édit_ol = .GetInspector.WordEditor édit_ol.Range.PasteAndFormat wdFormatOriginalFormatting
Questions/remarques

1 - Si je code

Code:

Dim édit_ol As Inspector

(J'évite tant que possible les déclarations en Variant)
Alors le code tombe en anomalie (13 - incompatibilité de type)

2 - L'image est bien collée mais en taille réduite.
Comment modifier alors ses propriétés Width et Height

3 - L'image écrase ma signature par défaut

Merci beaucoup.
30/08/2017, 17h15
patricktoulon

re

a ben oui il y a la fonction paste déjà pour le document de Outlook en edition ,je l'ignorais, comme je te l'ai dis je n'utilise pas du tout Outlook mais CDO

donc dans cette partie la je ne pourrais pas t'aider robert semble plus familiariser avec Outlook que moi peut être aura il une idée sur la question
30/08/2017, 17h18
MarcelG

Pas grave.
Merci Robert et Merci Patrick.
J'essaie de creuser.

Bonne soirée à tous.
30/08/2017, 19h49
patricktoulon

re

re
Marcel ton lien n'est pas valide j'aurais bien aimer le consulter
30/08/2017, 21h59
unparia

Bonjour Patrick

Citation:

Marcel ton lien n'est pas valide j'aurais bien aimer le consulter

corrige son adresse (simple) et --->>
https://www.developpez.net/forums/d1...el-corps-mail/
31/08/2017, 10h01
MarcelG

Bonjour le Forum,
Bonjour Patrick,

Excuse-moi.

plutôt ce lien

Copie Outlook Image

Salut,

Comme,

Code:

Dim wdDoc As Word.Document

J'ai recherché dans VBA de Word
(Voir mes commentaires)

Merci et Bonne journée.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub Envoi_Documents()
 
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
Dim édit_ol As Outlook.Inspector
 
'Requiert une référence à la bibliothèque d'objets Word
Dim wdDoc As Word.Document
Dim wdRange As Word.Range
 
With Worksheets("Mail")
        .Visible = True
        .Select
End With
 
Application.ScreenUpdating = True
 
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
 
With MonItem
 
        .To = "marcel@citron.fr"
        .Subject = "Coucou"
 
        .Display
 
        'copie du corps de texte dans le corps de message
        Call Création_img
 
        AppActivate "Coucou - Message" ' Active Outlook
 
        'https://www.developpez.net/forums/d1334291/logiciels/microsoft-office/outlook/vba-outlook/copier-coller-tableau-excel-corps-mail/
        Set édit_ol = .GetInspector
        Set wdDoc = édit_ol.WordEditor
 
        With wdDoc
                'Image en en-tête du corps de texte d'Outlook, au-dessus de la signature éventuelle
                .Range(0, 0).PasteAndFormat Type:=wdChartPicture
                'Image redimensionnée
                .InlineShapes(1).Width = 1000
        End With
 
        Set wdDoc = Nothing
        Set édit_ol = Nothing
 
        .Send
 
        Application.CutCopyMode = False
 
End With
 
Set MonItem = Nothing
Set Applic_Outlook = Nothing
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Création_img()
 
Dim S As Shape
 
With Worksheets("Mail")
 
        .Activate
 
        'Précaution éventuelle
        On Error Resume Next
        For Each S In .Shapes
                S.Delete
        Next S
        On Error GoTo 0
 
        .Range("corps_3").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        .Paste
 
        'Ici Shapes.Count =1 (Shapes supprimés ci-dessus)
        .Shapes(.Shapes.Count).Copy
        'Aucune utilité de garder l'image sur la feuille car préente dans le presse - papier
        .Shapes(.Shapes.Count).Delete
 
End With
 
End Sub

31/08/2017, 12h51
patricktoulon

re

re
Bonjour Marcel

dommage que je ne puisse tester avec Outlook 2007 je n'ai jamais réussi a le paramétrer

et merci a toi et jacques pour les liens