Option Explicit
' code de SilkyRoad alias MichelXLD
' [url=http://excel.developpez.com/faq/?page=PressePapier#ImageClipBoard]FAQ MS-Excel[/url]
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub Image_ClipBoard()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String
'Compte le nombre d'objet initial dans la feuille
x = ActiveSheet.Shapes.Count
Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
'Colle le contenu du presse papier dans la feuille de calcul
ActiveSheet.Paste
'vérifie si le collage effectué correspond à une image
If x = ActiveSheet.Shapes.Count Then
Application.ScreenUpdating = True
MsgBox "Opération annulée"
Exit Sub
Else
'Récupère la dernière forme de la feuille
Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
'Définit le nom et le lieu de stockage de l'image
monImage = "C:\monImage.jpg"
'Colle l'image dans un graphique
With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
.Paste
'Sauvegarde l'image du graphique au format jpg
.Export monImage, "JPG"
End With
'Supprime le graphique et la forme.
With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.Shapes(ActiveSheet.Shapes.Count).Delete
End With
Application.ScreenUpdating = True
'-------------------------------------------------------------
'Option pour les utilisateurs de Windows XP :
'visualisation de l'image créée, avec l'apercu images_telecopies Windows
'testé avec Excel2002 et WinXP
ShellExecute 0, "open", "rundll32.exe", _
"C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & monImage, 0, 1
End If
End Sub