Saving a picture

[pcc]

I have a workbook with various pictures in it, that I would like to save as .jpg files. If I set the macro recorder going, select the picture, then choose "Save as picture", enter the picture name, then "Save", it all seems to be fine. However, when I stop the macro recorder, and inspect the macro, all I get is

Sub Macro5()
    Range("O10").Select
    ActiveSheet.Shapes.Range(Array("Picture 2")).Select
End Sub

Can anyone advise the best way to export the pictures as individual .jpg files? I can export them to Powerpoint via VB and then save the .ppt files as .jpgs, but I need to be able to assign specific names to the .jpgs. (Powerpoint just does Slide1, Slide2 etc). Hope someone can advise. Regards

 

[DanteAmor]

With the following macro you save all the shapes of your sheet, just adjust the name of your sheet where you have the shapes and the name of the folder where you want to save the files.

Sub savePics()
  Dim cht As ChartObject
  Dim shp As Shape
  Dim shA As Worksheet, shT As Worksheet
  Dim sPath As String
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Set shA = Sheets("Sheet1")        'Fit to the name of your sheet
  sPath = "C:\trabajo\examples\"    'Fit your folder, where you are going to save the files
  
  
  Sheets.Add(, Sheets(Sheets.Count)).Name = "Temp_jpg"
  Set shT = Sheets("Temp_jpg")
  shT.Select
  For Each shp In shA.Shapes
    shp.Copy
    With shT.ChartObjects.Add(Left:=shT.Range("B2").Left, Top:=shT.Range("B2").Top, _
                              Width:=shp.Width, Height:=shp.Height)
      .Activate
      .Chart.Paste
      .Chart.Export sPath & shp.Name & ".jpg", "jpg"
      .Delete
    End With
  Next
  shT.Delete
  
  Application.ScreenUpdating = True
End Sub

 

[pcc]

That's perfect. I just made a small change so that the .jpg file's name is based on the name of the sheet where the picture existed. Thank you so much. Muchas gracias.
Regards