Convertir shapes en jpeg

' .....
Shapes(i).CopyPicture
'.....

Shapes.Range(Array("NomDunShape1", "NomDunShape2")).Select
    Selection.CopyPicture

Sub copie_image()
Dim Img As Object
Dim Chemin As String
Chemin = ActiveWorkbook.Path & "\"
Set Img = ActiveSheet.Shapes("Picture 1")
Img.DrawingObject.CopyPicture
With ActiveSheet.ChartObjects.Add(0, 0, Img.Width, Img.Height).Chart
  .Paste
  .Export Chemin & Img.Name & ".jpg", "JPG"
  .Parent.Delete
End With
End Sub

'Création de l'image
Dim img1 As Range 'déclare la variable imag (Image)
Dim img2 As Range 'déclare la variable imag (Image)

Set img1 = Sheets("Feuil1").Range("A1:B15")
Set img2 = Sheets("Feuil1").Range("A20")

'img1.Copy img2 'copie la plage  et la colle dans dest
    img1.Select
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    img2.Select
        Me.Paste
        ThisWorkbook.Names.Add "Image", Selection.Name 'mémorise dans le nom défini Image
        ActiveCell.Activate
    

Dim Pict As Object
On Error Resume Next
Set Pict = Me.Pictures([Image])
    Application.ScreenUpdating = False
    
Pict.Name = Range("F2").Value
Pict.CopyPicture 'copie la dernière image créée
With Me.ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
  .Paste 'colle l'image dans un graphique temporaire
  .Export "D:\" & Pict.Name & ".jpg", "JPG"
  .Parent.Delete 'Supprime le graphique

End With

'### Constante à adapter ###
Const MON_IMAGE As String = "C:\ma plage sélectionnée.jpg"
'###########################

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
  ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos& Lib "user32" (ByVal x As Long, ByVal y As Long)
Private Declare Function GetMessageExtraInfo& Lib "user32" ()
 
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4

'//////////////////////////////////////////////
'/// NE PAS LANCER LA MACRO A PARTIR DU VBE ///
'//////////////////////////////////////////////
Sub Selection2JPG()
Dim C As CommandBar
Dim B As CommandBarButton
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim S As Shape
Dim CO As ChartObject
Dim x&
Dim y&
Application.ScreenUpdating = True
Application.WindowState = xlMaximized
With ActiveWorkbook.Windows(1)
  .WindowState = xlMaximized
  x& = .Width \ 2
  y& = .Height \ 2
End With
Set S1 = ActiveSheet
Set S2 = Sheets.Add
Set C = CommandBars.Add
Set B = C.Controls.Add(Type:=msoControlButton, ID:=280)
S1.Activate
B.Execute
S2.Activate
SetCursorPos x&, y&
Call mouse_event(MOUSEEVENTF_LEFTDOWN, x&, y&, 0, GetMessageExtraInfo)     '
Call mouse_event(MOUSEEVENTF_LEFTUP, x&, y&, 0, GetMessageExtraInfo)
DoEvents
C.Delete
Set S = S2.Shapes(1)
With S
  .CopyPicture
  Set CO = S2.ChartObjects.Add(.Left, .Top, .Width, .Height)
End With
With CO.Chart
  .Paste
  .Export Filename:=MON_IMAGE
End With
Application.DisplayAlerts = False
S2.Delete
Application.DisplayAlerts = True
End Sub

Sub test()
'Création de l'image
Dim RngImg As Range 'déclare la variable imag (Image)
Dim img2 As Range 'déclare la variable imag (Image)
Dim Ch As Chart
Dim Im As Picture
 
Set RngImg = Range("A1:I23")
Set Ch = Charts.Add
 
'copier image
RngImg.CopyPicture xlScreen, xlPicture
 
'coller dans chart
Ch.Paste
 
'export vers jpeg
Ch.Export "D:\Test.jpg"
 
End Sub

RngImg.CopyPicture xlScreen, xlPicture

RngImg.CopyPicture xlScreen, xlBitmap

Private Sub CommandButton3_Click()
'Création de l'image
Dim RngImg As Range 'déclare la variable imag (Image)
Dim Ch As Chart
Dim Im As Picture
Dim A As Range




Set A = Sheets("Feuil1").Range("B4")

 
Set RngImg = Range("A1:B15")
Set Ch = Charts.Add

Ch.Name = Sheets("Feuil1").Range("B9").Value
'copier image
RngImg.CopyPicture xlScreen, xlPicture
 

'coller dans chart
Ch.Paste
 Application.ScreenUpdating = False
    With ActiveChart.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.17)
        .RightMargin = Application.InchesToPoints(0.19)
        .TopMargin = Application.InchesToPoints(0.33)
        .BottomMargin = Application.InchesToPoints(0.35)
        .HeaderMargin = Application.InchesToPoints(0.26)
        .FooterMargin = Application.InchesToPoints(0.19)
        .ChartSize = xlFullPage
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .BlackAndWhite = False
        .Zoom = 100
    End With
     Application.ScreenUpdating = True
     
    
'export vers jpeg
Ch.Export "D:\" & A & "\" & Ch.Name & ".jpg", "JPG"

Application.DisplayAlerts = False
    Ch.Delete 'Supprime le graphique

End Sub