Excel VBA Can't SaveAs Embedded PowerPoint Presentation in Office 2016

Question

We embed pptx files in Excel, then use Excel VBA code (like below) to open, then SaveAs the pptx file to the user's drive, then programmatically modify the pptx content based on Excel calculations.
The Excel VBA code below works fine to control PowerPoint 2010 and 2013, but no longer works for PowerPoint 2016.
Note: I have similar code for Word and it works fine for Word 2016 (and prior versions).

Sub OpenCopyOfEmbeddedPPTFile() 'works with Office 2010 and 2013, but not on Office 2016
    Dim oOleObj As OLEObject
    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim sFileName As String
    Set oOleObj = ActiveSheet.Shapes("PPTObj").OLEFormat.Object 'name of the embedded pptx object
    Set PPTApp = CreateObject("Powerpoint.Application")
    PPTApp.Visible = True
    sFileName = "C:\Users\Me\Documents\testPPT.pptx"
    OleObj.Verb Verb:=xlVerbOpen 'it opens successfully
    Set PPTPres = oOleObj.Object
    PPTPres.SaveAs Filename:=sFileName 'fails here (in Office 2016)
    PPTPres.Close
    GetObject(, "PowerPoint.Application").Presentations.Open sFileName
    'code to modify the Presentation (copy of the embedded pptx) based on Excel calculations
End Sub

Error:
Run-time error '-2147467259 (80004005)': Presentation.SaveAs : An error occurred while PowerPoint was saving the file.

Also, the following PowerPoint VBA (not Excel VBA) works fine for normal documents (not embedded in Excel), but fails when I run it in an opened embedded pptm. Works fine in 2013 and 2010 embedded pptm's.

ActivePresentation.SaveAs FileName:="C:\Users\Me\Documents\testPPT.pptm"

Error: Run-time error '-2147467259 (80004005)': Presentation (unknown member) : An error occurred while PowerPoint was saving the file.

Windows OS version does not seem to matter. Does not work on Office for Mac.

Any way to resolve or workaround this error? Or is there another way to do the same thing (modify a copy of the embedded pptx so the embedded pptx is not modified)? Or does this error only occur on our Office 2016 PCs?

Answer 1

Sub CreatePPTFromReport()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim slideIndex As Integer
    
    ' Créer une instance de PowerPoint
    On Error Resume Next
    Set pptApp = GetObject(class:="PowerPoint.Application")
    If pptApp Is Nothing Then
        Set pptApp = CreateObject(class:="PowerPoint.Application")
    End If
    On Error GoTo 0
    
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Add
    
    ' Diapositive 1 : Titre
    Set pptSlide = pptPres.Slides.Add(1, 1) ' 1 = ppLayoutTitle
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Rapport de Projet de Fin d'Études"
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = "Conception, dimensionnement et réalisation d'une presse hydraulique de 30 tonnes"
    
    ' Diapositive 2 : Introduction
    slideIndex = slideIndex + 1
    Set pptSlide = pptPres.Slides.Add(slideIndex + 1, 2) ' 2 = ppLayoutText
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Introduction"
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = _
        "Le présent rapport de projet de fin d'études (PFE) porte sur la conception, le dimensionnement et la réalisation d'une presse hydraulique d'une capacité de 30 tonnes. " & _
        "Ce projet s'inscrit dans le cadre de l'amélioration des équipements et des ressources pédagogiques du département de génie mécanique de l’ISETBizerte. " & _
        "La presse hydraulique est un outil indispensable dans de nombreux ateliers et laboratoires, permettant de réaliser diverses opérations telles que le formage, le pliage, le découpage et l'assemblage de matériaux."
    
    ' Diapositive 3 : Contexte et Objectifs
    slideIndex = slideIndex + 1
    Set pptSlide = pptPres.Slides.Add(slideIndex + 1, 2)
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Contexte et Objectifs"
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = _
        "L'idée de ce projet est née d'un double besoin : d'une part, l'acquisition d'une presse hydraulique d'atelier répondant aux exigences spécifiques des travaux pratiques (TP) des étudiants ; " & _
        "d'autre part, la volonté du département de génie mécanique de renforcer les compétences pratiques et techniques des futurs techniciens. " & _
        "Une presse hydraulique bien conçue et fonctionnelle permet non seulement d'améliorer la qualité de l'enseignement, mais aussi de garantir la sécurité et l'efficacité des opérations réalisées dans l’atelier."
    
    ' Diapositive 4 : Importance du Projet
    slideIndex = slideIndex + 1
    Set pptSlide = pptPres.Slides.Add(slideIndex + 1, 2)
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Importance du Projet"
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = _
        "Ce projet de fin d'études représente une opportunité unique de mettre en pratique les connaissances théoriques acquises au cours de notre formation " & _
        "et de contribuer de manière significative à l'enrichissement des ressources pédagogiques de notre département. " & _
        "Nous espérons que les résultats obtenus seront à la hauteur des attentes et permettront de former des ingénieurs encore mieux préparés aux défis technologiques de demain."
    
    ' Message de fin
    slideIndex = slideIndex + 1
    Set pptSlide = pptPres.Slides.Add(slideIndex + 1, 2)
    pptSlide.Shapes.Title.TextFrame.TextRange.Text = "Conclusion"
    pptSlide.Shapes.Placeholders(2).TextFrame.TextRange.Text = _
        "Merci de votre attention. Nous sommes ouverts à toutes questions ou discussions concernant notre projet."
    
    ' Finaliser
    pptApp.ActivePresentation.SaveAs "C:\Path\To\Your\Presentation.pptx"
    MsgBox "Présentation créée avec succès!", vbInformation
End Sub

Answer 2

I found this possible answer in another forum and it worked for me saving a PPTM file as a PPTX file as a copy

Change

PPTPres.SaveAs Filename:=sFileName 

to

PPTPres.SaveAs sFileName

Mine was :

PPTPres.SaveCopyAs sFileName

I then open the new file and close the PPTM file

Answer 3

PowerPoint 2016 appears to fail when using SaveAs or SaveCopyAs against an embedded presentation.

The workaround is to open the presentation, create a new presentation, and then copy the content from the embedded presentation to the new presentation. You can then close the embedded presentation, and save the new presentation as you wish.

I've demonstrated copying the slides, but you may need to programmatically copy BuiltInDocumentProperties and other non-slide content.

Option Explicit

Sub OpenCopyOfEmbeddedPPTFile() 'works with Office 2010 and 2013, but not on Office 2016
    Dim oOleObj As OLEObject
    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTNewPres As Object
    Dim sFileName As String
    Set oOleObj = ActiveSheet.Shapes("PPTObj").OLEFormat.Object 'name of the embedded pptx object

    oOleObj.Verb 3
    Set PPTPres = oOleObj.Object

    Set PPTApp = PPTPres.Application
    PPTApp.Visible = True

    'We can't save the embedded presentation in 2016, so let's copy the clides to a new presentation
    Set PPTNewPres = PPTApp.Presentations.Add
    PPTPres.Slides.Range.Copy
    PPTNewPres.Slides.Paste

    'We may need to copy other things, like BuiltInDocumentProperties
    'TODO

    'Close the original
    PPTPres.Close

    sFileName = "C:\Users\Me\Documents\testPPT121.pptx"
    sFileName = "C:\users\andrew\desktop\testPPT12111-FOOJANE.pptx"
    PPTNewPres.SaveAs sFileName

    'code to modify the Presentation (copy of the embedded pptx) based on Excel calculations

    'Quit PPT
    'PPTNewPres.Close
    'PPTApp.Quit

End Sub