Home | VBA Section | General Section | Downloads | Licensing | Privacy Policy

Extract embedded slides from a Word document

 

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-2007 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
 
 
 

Copyright © 1999-2008 Shyam Pillai. All rights reserved.