Option Explicit
Sub collage_Image_V03()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String
Dim m As Integer
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)
m = Sheets("Base").Range("F65536").End(xlUp).Row
monImage = "C:\" & Sheets("Base").Range("F" & m) & ".jpg"
With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
.Paste
.Export monImage, "JPG"
End With
With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.Shapes(ActiveSheet.Shapes.Count).Delete
End With
Application.ScreenUpdating = True
End If
End Sub