Hello les amis.
En utilisant ce code
Dim rngToPNG As Range ' La plage à enregistrer
Dim booGrid As Boolean ' Pour rétablir la grille telle qu'elle
Dim varExportPath As Variant ' Chemin complet d'enregistrement de l'image
' Sélection de la plage de cellule
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
' Demande à l'utilisateur le chemin où enregistrer l'image
varExportPath = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\image.png", "Image (*.png),*.png", , "Enregistrer sous forme d'image")
If varExportPath <> False Then
' Masquer les coulisses
Application.ScreenUpdating = False ' Figer l'écran
booGrid = ActiveWindow.DisplayGridlines ' Mémoriser la grille
ActiveWindow.DisplayGridlines = False ' Masquer la grille
' Mémoriser la zone sélectionnée par l'utilisateur
Set rngToPNG = Selection
' Sélectionner une cellule très loin du tableau pour être sûr que la création de la zone de graphique soit vide
Range("A1").SpecialCells(xlLastCell).Offset(5, 5).Select
' Création d'une zone de graphique et sélection de celle-ci
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
' Redimentionnement à la taille de la zone de cellules
ActiveSheet.Shapes(1).Height = rngToPNG.Rows.Height
ActiveSheet.Shapes(1).Width = rngToPNG.Columns.Width
' Copier la zone de cellules sous forme d'image
rngToPNG.CopyPicture xlScreen, xlPicture
' Collage dans la zone de graphique
ActiveChart.Paste
' Export sous forme d'image
ActiveChart.Export Filename:=varExportPath, FilterName:="PNG"
' Retour à la normale
ActiveSheet.Shapes(1).Delete
rngToPNG.Select
ActiveWindow.DisplayGridlines = booGrid
Application.ScreenUpdating = True
' Confirmation
MsgBox "L'image a bien été enregistrée...", vbInformation
End If
Je me retrouve avec des images qui ont des artefacts étranges (Comme s'il printscreenais un bout de fenêtre...) une idée ?