Sub Img_Jpg()
Dim Img As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Sub_Error
For Each Img In Me.Shapes
If Img.Type = msoLinkedPicture Then
nom = Img.Name
Img.Copy
Img.TopLeftCell.Select
Me.PasteSpecial Format:="Image (JPEG)"
Selection.Left = Img.Left
Selection.Top = Img.Top
Img.Delete
Selection.Name = nom
End If
Next
Sub_Error:
If Err <> 0 Then
MsgBox Err.Description
Stop
Resume Next
End If
Application.ScreenUpdating = True
MsgBox "Fin de la conversion"
Application.CommandBars.ExecuteMso "PicturesCompress"
End Sub