OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

This is a Microsoft Word macro which will extract embedded slides within a document and save them as presentation. Basically it takes you one step short of recreating the presentation that was original sent to Word from PowerPoint using the Send-To-Word export option.

We make use of the OLE verb Open to launch an embedded slide in its own PowerPoint session and then grab a reference to it since PowerPoint is a single window multi-use application. Then a  copy of the slide is saved as presentation into the specified folder.

Copy this code into a code module of a Word Document. Open the document containing the embedded slides. Execute this macro.

' ---------------------------------------------------------------------
' Copyright ©1999-2016 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.
' ---------------------------------------------------------------------

Option Explicit
Sub ExportEmbeddedSlidesAsPresentation()
Dim iPresCount As Integer
Dim iCtr As Integer
Dim oPPT As Object
Dim oDoc As Document
Set oDoc = ActiveDocument
For iCtr = 1 To oDoc.InlineShapes.Count
    If oDoc.InlineShapes(iCtr).Type = wdInlineShapeEmbeddedOLEObject Then
        If oDoc.InlineShapes(iCtr).OLEFormat.ProgID = "PowerPoint.Slide.8" Then
            oDoc.InlineShapes(iCtr).OLEFormat.DoVerb 2
            Set oPPT = CreateObject("PowerPoint.Application")
            Call oPPT.presentations(oPPT.presentations.Count) _
            .SaveCopyAs("C:\Some Folder\Slide" & iCtr & ".ppt")
            oPPT.presentations(oPPT.presentations.Count).Close
        End If
    End If
Next iCtr
oPPT.Quit
Set oPPT = Nothing
End Sub