Export Pictures Excel VBA - image

Question

I'm having trouble trying to select and export all pictures from a workbook. I only want the pictures. I need to select and save all of them as:"Photo 1", "Photo 2", "photo 3", and so on, in the same folder of the workbook.
I have already tried this code:
Sub ExportPictures()
Dim n As Long, shCount As Long
shCount = ActiveSheet.Shapes.Count
If Not shCount > 1 Then Exit Sub
For n = 1 To shCount - 1
With ActiveSheet.Shapes(n)
If InStr(.Name, "Picture") > 0 Then
Call ActiveSheet.Shapes(n).CopyPicture(xlScreen, xlPicture)
Call SavePicture(ActiveSheet.Shapes(n), "C:\Users\DYNASTEST-01\Desktop\TEST.jpg")
End If
End With
Next
End Sub

Answer 1

This code is based on what I found here. It has been heavily modified and somewhat streamlined. This code will save all the pictures in a Workbook from all Worksheets to the same folder as the Workbook, in JPG format.
It uses the Export() Method of the Chart object to accomplish this.
Sub ExportAllPictures()
Dim MyChart As Chart
Dim n As Long, shCount As Long
Dim Sht As Worksheet
Dim pictureNumber As Integer
Application.ScreenUpdating = False
pictureNumber = 1
For Each Sht In ActiveWorkbook.Sheets
shCount = Sht.Shapes.Count
If Not shCount > 0 Then Exit Sub
For n = 1 To shCount
If InStr(Sht.Shapes(n).Name, "Picture") > 0 Then
'create chart as a canvas for saving this picture
Set MyChart = Charts.Add
MyChart.Name = "TemporaryPictureChart"
'move chart to the sheet where the picture is
Set MyChart = MyChart.Location(Where:=xlLocationAsObject, Name:=Sht.Name)
'resize chart to picture size
MyChart.ChartArea.Width = Sht.Shapes(n).Width
MyChart.ChartArea.Height = Sht.Shapes(n).Height
MyChart.Parent.Border.LineStyle = 0 'remove shape container border
'copy picture
Sht.Shapes(n).Copy
'paste picture into chart
MyChart.ChartArea.Select
MyChart.Paste
'save chart as jpg
MyChart.Export Filename:=Sht.Parent.Path & "\Picture-" & pictureNumber & ".jpg", FilterName:="jpg"
pictureNumber = pictureNumber + 1
'delete chart
Sht.Cells(1, 1).Activate
Sht.ChartObjects(Sht.ChartObjects.Count).Delete
End If
Next
Next Sht
Application.ScreenUpdating = True
End Sub

Answer 2

One easy approach if your excel file is an Open XML format:
add a ZIP extension to your filename
explore the resulting ZIP package, and look for the \xl\media subfolder
all your embedded pictures should be located there as independent image files

Answer 3

Ross's method works well but using the add method with Chart forces to leave the currently activated worksheet... which you may not want to do.
In order to avoid that you could use ChartObject
Public Sub AddChartObjects()
Dim chtObj As ChartObject
With ThisWorkbook.Worksheets("A")
.Activate
Set chtObj = .ChartObjects.Add(100, 30, 400, 250)
chtObj.Name = "TemporaryPictureChart"
'resize chart to picture size
chtObj.Width = .Shapes("TestPicture").Width
chtObj.Height = .Shapes("TestPicture").Height
ActiveSheet.Shapes.Range(Array("TestPicture")).Select
Selection.Copy
ActiveSheet.ChartObjects("TemporaryPictureChart").Activate
ActiveChart.Paste
ActiveChart.Export Filename:="C:\TestPicture.jpg", FilterName:="jpg"
chtObj.Delete
End With
End Sub