VBA runtime error: save PowerPoint Presentation as PDF

Question

I create a Powerpoint presentation from an Excel workbook (both version 2016) and in the end I want to save the presentation as pdf.

I tried:

filenamePPT = Environ("UserProfile") & "\Desktop\" & Format(Date, "yyyy_mm_dd") & "_Statusbericht_" & ApName & "_KW" & KW & ".pdf"

ActivePresentation.ExportAsFixedFormat filenamePPT, ppFixedFormatTypePDF

and am getting:

runtime error: -2147221165 (80040154): class not registered

in the second line.

In my opinion, I did everything accordingly to the Microsoft Documentation.

EDIT:

All relevant references are added:

PowerPoint 16.0 Object Library
OLE Automation
Office 16.0 Object Library
Forms 2.0 Object Library
ActiveX Data Objects 6.1 Library
ActiveX Data Objects Recordset 6.0 Library

EDIT2:

Public createslide6 As Boolean
Public ChartrngVONstring As String
Public ChartrngBISstring As String
Public filenameEXCEL As String
Public user As String


Sub VBA_AP_Status_v1()


Dim year As Double
Dim ZKW1 As Double
Dim ZKW2 As Double
Dim ZKW3 As Double
Dim ZKW4 As Double
Dim ZKW5 As Double
Dim ZKW6 As Double
Dim ZKW7 As Double
Dim ZKW8 As Double
Dim MS1Dauer As Double
Dim MS2Dauer As Double
Dim MS3Dauer As Double
Dim MS4Dauer As Double
Dim MS5Dauer As Double
Dim MS6Dauer As Double
Dim MS7Dauer As Double
Dim MS8Dauer As Double
Dim minScale As Double
Dim maxScale As Double
Dim e As Integer
Dim yearString As String
Dim nextyearString As String
Dim StandortVar As String
Dim filenamePPT As String
Dim pptLayout As CustomLayout

Dim AllgShape As Object
Dim MSShape As Object
Dim MSTShape As Object
Dim BemShape As Object
Dim APUShape As Object
Dim LGShape As Object
Dim HLShape As Object
Dim SlideNum As Object
Dim Fußzeile As Object
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide1 As Object
Dim mySlide2 As Object
Dim mySlide3 As Object
Dim mySlide4 As Object
Dim mySlide5 As Object
Dim mySlide6 As Object
Dim mySlide7 As Object
Dim myShape As Object
Dim ppTextbox As Object
Dim Chart1 As Object
Dim ChartLegend As Object
Dim MSPfeilLang As Object
Dim MSPfeilKurz As Object
Dim MSDreieck1 As Object
Dim MSDreieck2 As Object
Dim MSDreieck3 As Object
Dim MSDreieck4 As Object
Dim MSDreieck5 As Object
Dim MSDreieck6 As Object
Dim RisikenTable As Object



user = Environ("username")
year = Format(Date, "yyyy")
yearString = Format(Date, "yyyy")
nextyearString = Format(Date, "yyyy") + 1


'Create an Instance of PowerPoint
  On Error Resume Next

'Is PowerPoint already opened?
  Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
  Err.Clear

'If PowerPoint is not already open then open PowerPoint
  If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

'Handle if the PowerPoint Application is not found
  If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, aborting."
    Exit Sub
  End If

  On Error GoTo 0

'Optimize Code
  Application.ScreenUpdating = False

'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add


  myPresentation.ApplyTemplate "C:\Users\" & user & "\AppData\Roaming\Microsoft\Templates\Document Themes\AP_Status_Vorlage.thmx"


'Add slides to the Presentation
  Set mySlide1 = myPresentation.Slides.Add(1, ppLayoutCustom)       'an pos 1     '11 = ppLayoutTitleOnly
  Set mySlide2 = myPresentation.Slides.Add(2, ppLayoutTitleOnly)


  Set ppTextbox = mySlide1.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 80, 800, 80)




~ 2k lines of code were deleted here





filenameEXCEL = "C:\users\" & user & "\Desktop\Daten_Statusbericht_" & ApName & "_KW" & KW & "_" & Format(Date, "dd_mm_yy")
filenamePPT = Environ("UserProfile") & "\Desktop\" & Format(Date, "yyyy_mm_dd") & "_Statusbericht_" & ApName & "_KW" & KW & ".pdf"

'Make PowerPoint Visible and Active // OPTIONAL
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False

'SAVING & CLOSING Powerpoint

  ActivePresentation.ExportAsFixedFormat filenamePPT, ppFixedFormatTypePDF

  'If Not GetObject(, "PowerPoint.Application") Is Nothing Then
    'GetObject(, "PowerPoint.Application").Quit
  'End If


'Call CloseAndSaveExcelApplication

End Sub

Any suggestions?

@BigBen I edited the question. Yes I did add the object library for PP — Clemens Ambros
@SiddharthRout unfortunately that's not possible. It is 3k lines long and contains sensitive information. Basically there is nothing else which has relevance for the saving process — Clemens Ambros
I am more interested in how are you working with powerpoint objects (declaring and initializing objects) — Siddharth Rout
@SiddharthRout is there an object involved in this commands? In the beginning, I am declaring dim xy as Object several times but not for this saving process. It does make no difference if I write dim filenamePPT as String beforehand. Do I have to set ActivePresentation = something? — Clemens Ambros

Siddharth Rout Siddharth Rout · Accepted Answer · 2020-03-11T15:06:43

Dim PowerPointApp As Object

Dim myPresentation As Object

Dim mySlide1 As Object

You have used late binding and early binding together. Try this

Option Explicit

Sub Sample()
    Dim oPPApp As PowerPoint.Application
    Dim oPPPrsn As PowerPoint.Presentation
    Dim oPPSlide As PowerPoint.Slide
    
    Dim FlName As String
    
    '~~> Change this to the relevant file
    FlName = "C:\Users\routs\Desktop\test.pdf"
    
    '~~> Establish an PowerPoint application object
    On Error Resume Next
    Set oPPApp = GetObject(, "PowerPoint.Application")
    
    If Err.Number <> 0 Then
        Set oPPApp = CreateObject("PowerPoint.Application")
    End If
    Err.Clear
    On Error GoTo 0
    
    oPPApp.Visible = True
    
    '~~> Open the relevant powerpoint file
    Set oPPPrsn = oPPApp.Presentations.Add
    
    '~~> Change this to the relevant slide which has the shape
    Set oPPSlide = oPPPrsn.Slides.Add(1, ppLayoutCustom)
    
    oPPPrsn.ExportAsFixedFormat FlName, ppFixedFormatTypePDF
End Sub

VBA runtime error: save PowerPoint Presentation as PDF

1 Answers