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

【问题标题】：Reference Excel cell in PowerPoint macro for filename文件名在 PowerPoint 宏中引用 Excel 单元格
【发布时间】：2017-04-14 12:59:31
【问题描述】：

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

有没有办法在 PowerPoint 中运行的这个宏中引用 Excel 文件中的单元格来获取文件名？

Sub pppdf()

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

End Sub

我可以在 Excel 中将 PowerPoint 文件另存为 .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 工作簿和工作表。

【问题讨论】：

标签： vba excel powerpoint

【解决方案1】：

如果大部分代码都在 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>") 代码行，目前在我上面的示例中已被注释掉。

【讨论】：

谢谢达伦，你在这个答案中做了很多工作，但你的一行代码实际上让我大开眼界。我一直在尝试使用 Excel VBA 中的 ExportAsFixedFormat，但 PP.SaveAs ThisWorkbook.Path & Application.PathSeparator & "ABC", 32 'ppSaveAsPDF 效果很好。只需将 SaveAs 与 pdf 编号一起使用。伟大的！再次感谢！

【解决方案2】：

您在 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

【讨论】：