VBA 运行时错误：将 PowerPoint 演示文稿另存为 PDF

Question

我从 Excel 工作簿（均为 2016 版）创建了一个 Powerpoint 演示文稿，最后我想将演示文稿另存为 pdf。

我试过：

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

ActivePresentation.ExportAsFixedFormat filenamePPT, ppFixedFormatTypePDF

并且得到：

运行时错误：-2147221165 (80040154)：类未注册

在第二行。

在我看来，我按照Microsoft 文档做了所有事情。

编辑：

添加所有相关参考文献：

• PowerPoint 16.0 对象库
• OLE自动化
• Office 16.0 对象库
• Forms 2.0 对象库
• ActiveX 数据对象 6.1 库
• ActiveX 数据对象记录集 6.0 库

编辑2：

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

有什么建议？

Answer 1

将 PowerPointApp 调暗为对象

将我的演示文稿调暗为对象

将 mySlide1 调暗为对象

您已将后期绑定和早期绑定一起使用。 尝试这个

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