在文件名的 PowerPoint 宏中引用 Excel 单元格

Question

我无法使用 Excel VBA 中的 SaveAsFixedFormat 将 PowerPoint 文件导出为 PDF。我求助于从 Excel VBA 的预设 powerpoint 中启动一个宏，直接从 PowerPoint 将演示文稿导出为 pdf。

有什么方法可以在 PowerPoint 中的运行这个宏中引用 Excel 文件中的单元格来获取文件名吗？

Sub pppdf()

ActivePresentation.ExportAsFixedFormat "M:\random\test.pdf", 32

End Sub

我可以将 PowerPoint 文件另存为 Excel 的 .pptx 并使用不同的文件名和路径，但现在我想在导出为 pdf 的 PowerPoint 宏中引用这些相同的路径和文件名。

最后我希望代码看起来像这样，但这显然需要一些工作才能在 PowerPoint 中运行：

Dim FName           As String
Dim FPath           As String

FPath = Range("SavingPath").Value
FName = Sheets("randomworksheet").Range("A1").Text

ActivePresentation.ExportAsFixedFormat FPath & FName & " Development" & ".pdf", 32

此 PowerPoint 宏将从 Excel 开始，PowerPoint 文件和 Excel 工作簿和 sheet 将在执行时打开。

Answer 1

直接从 Excel VBE 使用 ExportAsFixedFormat 时遇到什么问题？根据 documentation（似乎不正确）和 PowerPoint VBE IntelliSense，第二个参数 FixedFormatType 只能是以下两个值之一：

ExportAsFixedFormat(Path, FixedFormatType, Intent, FrameSlides, _
                    HandoutOrder, OutputType, PrintHiddenSlides, PrintRange, _
                    RangeType, SlideShowName, IncludeDocProperties, KeepIRMSettings)

FixedFormatType:

ppFixedFormatTypePDF = 2
ppFixedFormatTypeXPS = 1

Answer 2

如果大部分代码都在 Excel 中，为什么不打开演示文稿并将其另存为来自 Excel 的 PDF？

Sub SavePPTXasPDF()

    Dim PPT As Object
    Dim PP As Object

    Set PPT = CreatePPT
    Set PP = PPT.Presentations.Open("<FullPathToPresentation>")

    PP.SaveAs ThisWorkbook.Path & Application.PathSeparator & "ABC", 32 'ppSaveAsPDF

End Sub


Public Function CreatePPT(Optional bVisible As Boolean = True) As Object

    Dim oTmpPPT As Object

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Powerpoint is not running. '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpPPT = GetObject(, "Powerpoint.Application")

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Powerpoint. '
    'Reinstate error handling.                                 '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpPPT = CreateObject("Powerpoint.Application")
    End If

    oTmpPPT.Visible = bVisible
    Set CreatePPT = oTmpPPT

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreatePPT."
            Err.Clear
    End Select

End Function

或者如果您想运行 Powerpoint 中的代码：

Public Sub Test()

    Dim oXL As Object
    Dim oWB As Object
    Dim FName           As String
    Dim FPath           As String

    Set oXL = CreateXL
    Set oWB = oXL.workbooks.Open("<Path&FileName>")

    'Or if Workbook is already open:
    'Set oWB = oXL.workbooks("<FileName>")

    FPath = oWB.worksheets("Sheet1").Range("A1")
    FName = oWB.worksheets("Sheet1").Range("A3")

    ActivePresentation.ExportAsFixedFormat FPath & FName & " Development" & ".pdf", 32

End Sub

Public Function CreateXL(Optional bVisible As Boolean = True) As Object

    Dim oTmpXL As Object

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpXL = CreateObject("Excel.Application")
    End If

    oTmpXL.Visible = bVisible
    Set CreateXL = oTmpXL

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateXL."
            Err.Clear
    End Select

End Function

或者您可以按照您的要求从 Excel 中打开演示文稿并执行演示文稿中存储的代码：

Sub SavePPTXasPDF()

    Dim PPT As Object
    Dim PP As Object

    Set PPT = CreatePPT
    Set PP = PPT.Presentations.Open("<FullPath>")
    PPT.Run PP.Name & "!Test"

End Sub

这将使用 Test 宏并使用 Set oWB = oXL.workbooks("<FileName>") 代码行，目前在我上面的示例中被注释掉了。

在文件名的 PowerPoint 宏中引用 Excel 单元格

Reference Excel cell in PowerPoint macro for filename

excel

powerpoint

vba