How to extract images from a presentation

The routine below will extract all the images in a given presentation and copy then to the designated folder. The images will be exported at their original resolution. The routine copies an image shape onto another presentation and resizes the slide such that the pasted image fills the slide and then exports this slide as a picture format file. To obtain the original image from this export, the trick is to not to pass the optional Height and Width arguments while exporting the slide. PowerPoint will intelligently export the image at the original resolution.

In PowerPoint 2000 and later, there exists a hidden Export method associated with a shape which one can make use of directly. Here is an example which exploits that hidden method.

This routine while soon be included in Toolbox

'-------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
'-------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' -------------------------------------------------------------------------

Sub ExtractImagesFromPres97()
On Error GoTo ErrorExtract
Dim oPres As Presentation
Dim oSldSource As Slide
Dim oShpImg As ShapeRange
Dim oShpSource As Shape
Dim oSld As Slide
Dim oShp As Shape
Dim Ctr As Integer
Dim sPath As String
sPath = "D:\Temp\"
Ctr = 0
For Each oSldSource In ActivePresentation.Slides
    For Each oShpSource In oSldSource.Shapes
        If oShpSource.Type = msoPicture Then
            Set oShp = oShpSource
            Set oPres = Presentations.Add(False)
            With oPres.PageSetup
                .SlideSize = ppSlideSizeCustom
                .SlideHeight = oShp.Height
                .SlideWidth = oShp.Width
            End With
            Set oSld = oPres.Slides.Add(1, ppLayoutBlank)
            oShp.Copy
            Set oShpImg = oSld.Shapes.Paste
            With oShpImg
                .Left = 0
                .Top = 0
            End With
            Ctr = Ctr + 1
            Call oSld.Export(sPath & "Img" & Format(Ctr, "00000") & ".JPG", "JPG")
            oPres.Close
        End If
    Next oShpSource
Next oSldSource
If Ctr = 0 Then
    MsgBox "There were no images found in this presentation", _
        vbInformation, "Image extraction failed."
End If
Exit Sub
ErrorExtract:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End If
End Sub

' Requires PowerPoint 2000 and later
Sub ExtractImagesFromPres()
On Error GoTo ErrorExtract
Dim oSldSource As Slide
Dim oShpSource As Shape
Dim Ctr As Integer
Dim sPath As String

sPath = "C:\"
Ctr = 0
For Each oSldSource In ActivePresentation.Slides
    For Each oShpSource In oSldSource.Shapes
        If oShpSource.Type = msoPicture Then
            ' Hidden Export method
            Call oShpSource.Export(sPath & "Img" & _
            Format(Ctr, "0000") & ".JPG", ppShapeFormatJPG)
            Ctr = Ctr + 1
        End If
    Next oShpSource
Next oSldSource
If Ctr = 0 Then
    MsgBox "There were no images found in this presentation", _
            vbInformation, "Image extraction failed."
End If
Exit Sub
ErrorExtract:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End If
End Sub

Top