Sub Range_To_Image()
Dim ObjChrt As Chart
Dim RngImage As Range
Dim strFile As String
On Error GoTo ErrExit
With ActiveSheet
Set RngImage = .Range("A1:L150")
RngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
strFile = "C:\Users\TOTO\Desktop\Plage.jpg"
Set ObjChrt = .ChartObjects.Add(RngImage.Left, RngImage.Top, RngImage.Width, RngImage.Height).Chart
With ObjChrt
.Parent.Activate
.ChartArea.Format.Line.Visible = msoFalse
.Paste
.Export strFile
.Parent.Delete
End With
End With
ErrExit:
Set ObjChrt = Nothing
Set RngImage = Nothing
End Sub
Sub Photo()
' Selectionne la zone B2:D64, prends la photo et la range en Feuil2
Range("B2:D64").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Sheets("Feuil2").Select
ActiveSheet.Paste
End Sub
Sub Range_To_Image()
Dim RngImage As Range, strFile As String
strFile = Environ("userprofile") & "\Desktop\Plage.gif" 'on exporte en gif c'est plus nette qu'en jpg
On Error GoTo ErrExit ' je laisse la gestion d'erreur au cas ou il y aurait une protection par exemple
With ActiveSheet
Set RngImage = .Range("A1:L150")
Application.CutCopyMode = False ' on vide la memoire au cas ou une precedente capture serait dans le clip( NON GARANTIE !!!!!pas tout le temps effectif seules les apis pourront vider réellement le clip)
RngImage.CopyPicture ' on copy en WMF plus rapide
With .ChartObjects.Add(10, 10, RngImage.Width, RngImage.Height).Chart
.Parent.Activate
.ChartArea.Format.Line.Visible = msoFalse
.Paste
' on évite d'avoir une image blanche sur certaines versions d'office récentes en attendant qu'il y est une image collée dans le chart
Do While .Pictures.Count = 0: DoEvents: Loop
.Export strFile
.Parent.Delete
End With
End With
ErrExit:
Set ObjChrt = Nothing
Set RngImage = Nothing
End Sub
Bonjour BrunoM45,Voici
VB:Sub Range_To_Image() Dim ObjChrt As Chart Dim RngImage As Range Dim strFile As String On Error GoTo ErrExit With ActiveSheet Set RngImage = .Range("A1:L150") RngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap strFile = "C:\Users\TOTO\Desktop\Plage.jpg" Set ObjChrt = .ChartObjects.Add(RngImage.Left, RngImage.Top, RngImage.Width, RngImage.Height).Chart With ObjChrt .Parent.Activate .ChartArea.Format.Line.Visible = msoFalse .Paste .Export strFile .Parent.Delete End With End With ErrExit: Set ObjChrt = Nothing Set RngImage = Nothing End Sub
A+