[MichelXld]

bonjour cher Philippe

j'espere que cet exemple pourra t'aider


Option Explicit

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 collage_Image_V02()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String

x = ActiveSheet.Shapes.Count

Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
ActiveSheet.Paste

'verifie si le collage effectué correspond à une image
If x = ActiveSheet.Shapes.Count Then
Application.ScreenUpdating = True
MsgBox "Opération annulée"
Exit Sub

Else

Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
monImage = "C:\monImage.jpg"

With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
.Paste
.Export monImage, "JPG"
End With

With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Dele te
.Shapes(ActiveSheet.Shapes.Count).Delete
End With

Application.ScreenUpdating = True

'-------------------------------------------------------------
'option pour les utilisateur de Windows XP :
'visualisation de l'image créée avec avec l'apercu images_telecopies Windows
'testé avec Excel2002 et WinXP

ShellExecute 0, "open", "rundll32.exe", _
"C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscr een" & monImage, 0, 1
End If

End Sub


bonne journée
MichelXld