编译错误：未在 Excel 中使用 PowerPoint VBA 定义用户定义类型

Question

Sub SELLSHEETUPDATES_Macro()

Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim onlyFileName As String, folderPath As String, pptFiles As String, removeFileExt As Long

Application.ScreenUpdating = False

folderPath = Range("C5").Text & ""
pptFiles = Dir(folderPath & "*.pp*")

If pptFiles = "" Then
MsgBox "No files found"
Exit Sub
End If

Do While pptFiles \<\> ""

Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue

On Error Resume Next
Set oPPTFile = oPPTApp.Presentations.Open(folderPath & pptFiles)

On Error GoTo 0
removeFileExt = InStr(1, oPPTFile.Name, ".") - 1
onlyFileName = Left(oPPTFile.Name, removeFileExt)

On Error Resume Next

oPPTFile.ExportAsFixedFormat oPPTFile.Path & "" & onlyFileName & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
oPPTFile.Close

pptFiles = Dir()
Loop

oPPTApp.Quit

Set oPPTFile = Nothing
Set oPPTApp = Nothing

Application.ScreenUpdating = True

MsgBox " Successfully converted"
End Sub
Sub SELLSHEETUPDATES()

End Sub

它突出了

Sub SELLSHEETUPDATES_Macro()

我在 google 上搜索了这段代码，将所有 PowerPoint 演示文稿作为单独的 PDF 文件保存在一个文件夹中。这是为了减少打开每个 PowerPoint 文件并将副本另存为 PDF 文件的时间。

Answer 1

ppFixedFormatTypePDF 和 ppFixedFormatIntentPrint 都是 PowerPoint 定义的常量； Excel 不知道它们是什么，因此会出现错误消息。

要么对它们都使用 2，要么在模块顶部将它们都定义为常量（如 Long = 2）。

Do While pptFiles \<\> ""

应该是

Do While pptFiles <> ""

或者更好，

Do While Len(pptFiles) = 0

此外，您每次通过循环都会创建 PPT 应用程序对象，但在退出循环之前不会释放它。在循环开始之前创建对象。

最后，你的代码有点像 ChatGPT arfs 的东西。它似乎想要在 Excel 中完成所有工作，即使您要求在 PPT 中完成更简单的事情。除了在 Excel 的单元格中包含文件夹名称之外，这样做还有其他特殊价值吗？

Answer 2

这对我有用：

Option Explicit

Sub RunPowerPointToPDF()
    ' Call the PowerPoint to PDF conversion macro
    ConvertPowerPointToPDF
End Sub

Sub ConvertPowerPointToPDF()
    Dim objPPT As Object
    Dim objPresentation As Object
    Dim strFolder As String
    Dim strFile As String
    
    ' Set the folder path
    strFolder = "C:location"
    
    ' Create PowerPoint application
    On Error Resume Next
    Set objPPT = CreateObject("PowerPoint.Application")
    On Error GoTo 0
    
    If objPPT Is Nothing Then
        MsgBox "PowerPoint is not available. Please make sure PowerPoint is installed.", vbExclamation
        Exit Sub
    End If
    
    objPPT.Visible = msoTrue ' Show PowerPoint application
    
    ' Loop through all PowerPoint files in the folder
strFile = Dir(strFolder & "*.ppt*")
Do While strFile <> ""
    ' Open PowerPoint presentation
    Set objPresentation = objPPT.Presentations.Open(strFolder & strFile)
    
    If Not objPresentation Is Nothing Then
        ' Save as PDF
        objPresentation.SaveAs strFolder & Replace(strFile, ".ppt", ".pdf"), 32 ' 32 corresponds to ppSaveAsPDF
        
        ' Close the presentation
        objPresentation.Close
    End If
    
    ' Get the next file
    strFile = Dir
Loop

    
    ' Quit PowerPoint application
    objPPT.Quit
    Set objPPT = Nothing
End Sub