Sub Export()
Application.ScreenUpdating = False
On Error GoTo ExportErreur
Dim Plage As Range
Dim FichierImage As Variant
Dim Titre As String
Titre = InputBox(Prompt:="Ajouter un titre à l'export ? (facultatif)")
Cells(2, 12) = Titre
Set Plage = Range("A2:W20").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:=Titre, FileFilter:="Image file (*.png), *.png")
If FichierImage <> False Then
ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
End If
ActiveSheet.ChartObjects("ExportImage").Delete
Cells(2, 12) = ""
Application.ScreenUpdating = True
Exit Sub
ExportErreur:
MsgBox "Une erreur est survenue..."
Application.ScreenUpdating = True
End Sub