Results 1 to 2 of 2

Thread: Exporting pictures from PPT to a folder and subfolders

  1. #1

    Exporting pictures from PPT to a folder and subfolders

    Hello all,

    I have a teaching presentation where screenshots are inserted in a number of slides (in the selection pane, the screenshots are named "Picture X" where the X is a number; the name being more or less randomly assigned by PPT when the image is pasted into the slide.) Only some slides show screenshots (some have a single image, some have multiple), others have no pictures at all.

    What I'd need is a macro to go through each slide; when it encounters an element named "Picture X", it makes a copy of the element and saves it as a PNG into an "Images" folder on the desktop. The filename of the saved pic should be the slide number. In cases where there is more than one pic in a slide, it should save the topmost pic to "Images", then the pic underneath to a subfolder (i.e. Images\A), and the pic under that to a different subfolder (i.e. Images\B), and so on. Note I don't want it to copy the slide itself, only the specific picture elements.

    To illustrate, let's say that this is the PPT selection pane for slide 5:

    Text 1
    Picture 12
    Rectangle 1
    Line 4
    Picture 3
    Picture 7

    I'd need the topmost picture (in the example above: "Picture 12") to be saved as "5.PNG" (i.e. the slide number) to an "Images" folder created on the desktop.
    Then the next image ("Picture 3") saved as "5.PNG" to Images\A.
    Then the pic underneath that ("Picture 7") saved as "5.PNG" to Images\B, and so on.

    When the macro ends, the "Images" folder would contain all the topmost pics from the entire presentation, the "A" subfolder would contain all the second-from-top images, the "B" subfoldfer all the 3rd-from-top images, and so on.

    I don't know how to do this in VBA in PPT (I'm not even sure it's possible). Any help would be very warmly appreciated, and would save me hours of mind-bendingly dull manual work.

    Thanks in advance for any help.


  2. #2
    VBAX Master
    Feb 2007
    This might need a bit of work from you but should get you started.

    Sub exporter()
    Dim opic As Shape
    Dim L As Long
    Dim x As Long
    Dim osld As Slide
    On Error Resume Next
    For Each osld In ActivePresentation.Slides
    For L = osld.Shapes.Count To 1 Step -1
    If isPic(osld.Shapes(L)) Then
    If x < 64 Then x = 64
    Select Case x
    Case 64
    MkDir (Environ("USERPROFILE") & "\Desktop\Images\")
    Call osld.Shapes(L).Export(Environ("USERPROFILE") & "\Desktop\Images\" & _
    osld.SlideIndex & ".png", ppShapeFormatPNG)
    x = x + 1
    Case Else
    MkDir (Environ("USERPROFILE") & "\Desktop\Images\" & UCase(Chr(x)) & "\")
    Call osld.Shapes(L).Export(Environ("USERPROFILE") & "\Desktop\Images\" & UCase(Chr(x)) & _
    "\" & osld.SlideIndex & ".png", ppShapeFormatPNG)
    x = x + 1
    End Select
    End If
    Next L
    x = 0
    Next osld
    End Sub
    Function isPic(osld As Slide)
    Dim oshp As Shape
    For Each oshp In osld.Shapes
    If oshp.Type = msoPicture Then
    isPic = True
    Exit Function
    End If
    If oshp.Type = msoPlaceholder Then
    If oshp.PlaceholderFormat.ContainedType = msoPicture Then
    isPic = True
    Exit Function
    End If
    End If
    Next oshp
    End Function
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts