Sub FICHAT_SAVE_IMAGE()
Application.ScreenUpdating = False
On Error GoTo ExportErreur
Dim Plage As Range
Dim FichierImage As Variant
Dim NomImage As Variant
NomImage = [AK4].Value 'récupérer le nom sur la fiche
NomImage = Mid(NomImage, 2, 12) 'retirer les balises
Set Plage = Range("A13:BE55").Cells
Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ActiveSheet.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
.Name = "ExportImage"
.Activate
End With
ActiveChart.Paste
FichierImage = Application.GetSaveAsFilename(InitialFileName:=NomImage & ".jpg", FileFilter:="Image file (*.jpg), *.jpg")
If FichierImage <> False Then
ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
End If
ActiveSheet.ChartObjects("ExportImage").Delete
Application.ScreenUpdating = True
Exit Sub
ExportErreur:
MsgBox "Une erreur est survenue..."
Application.ScreenUpdating = True
End Sub