将 Powerpoint 导出为单个 PDF,每页作为图像

将 Powerpoint 导出为单个 PDF,每页作为图像

我有一个 Powerpoint 演示文稿。我想将其转换为 PDF。如果我保存副本并使用 PDF,至少有两个问题我想避免:

  1. 文本是可选的。这也许可以通过 PDF 文件的安全设置来避免。

  2. 我记得偶尔会看到(很遗憾现在我无法重现)生成的 PDF 存在一些轻微的排列问题。

避免这些问题的一种方法是将每张幻灯片导出为纯图像。我可以处理这条路线,但有两点让它变得有些麻烦,我打算摆脱它们:

  1. 从 Powerpoint 导出为 jpg 时(例如),没有选项可以避免导出隐藏幻灯片(这直接保存为 PDF 即可完成。

  2. 当从 Powerpoint 导出为 jpg 时(例如),每张幻灯片都会单独导出。必须手动将所有图像链接到 pdf 中。

有什么办法可以实现我的目标吗? 我想我可以为此编写 VBA 代码,但我不想重新发明轮子。

答案1

将演示文稿的副本保存为 PowerPoint 图片演示文稿。这样您将获得一个 PPTX,其中每张幻灯片都是原始幻灯片的图像。

保存时不要覆盖原始演示文稿。幻灯片转换为图像后,您无法再转换回可编辑幻灯片。

检查确保原始幻灯片中隐藏的幻灯片在保存的图片演示文稿中仍然隐藏。如果不是,您需要在保存为 PDF 之前再次隐藏它们。

答案2

在 Steve Rindsberg 的回答中进行了评论交流后,我得出结论,应该使用 VBA(我本想避免使用)。我在这里发布了我使用的代码。在编写代码时,它提供了添加功能的灵活性,例如,不导出隐藏的幻灯片。
我将图像串联到单个 PDF 文件中(这也可以使用 Adob​​e Acrobat、ImageMagick 的转换等来完成)。
请注意,ExportAsFixedFormat需要ppFixedFormatIntentPrint,否则输出质量会再次下降。
希望这对其他人有用。

Sub ppt2images(Optional path As String = "")
    '
    ' If not given, use for the output directory the same as in the original presentation
    '
    On Error GoTo Err_ImageSave

    ' Set paths and file names
    Dim oPres As Presentation
    Set oPres = ActivePresentation
    Dim sImagePath As String
    Dim sPrefix As String
    sPrefix = Split(oPres.Name, ".")(0)
    If (path = "") Then
        path = oPres.path
    End If
    sImagePath = path & "\" & sPrefix
    If Dir(sImagePath, vbDirectory) <> vbNullString Then
        'MsgBox "Folder " & sImagePath & " exist"
    Else
        MkDir (sImagePath)
    End If
   
    ' Get current resolution
    Dim ps As PageSetup
    Set ps = oPres.PageSetup
    Dim lScaleWidth As Long '* Scale Width
    Dim lScaleHeight As Long '* Scale Height
    lScaleWidth = ps.SlideWidth
    lScaleHeight = ps.SlideHeight
    Dim ar As Double
    ar = lScaleWidth / lScaleHeight
    
    ' Set target resolution
    Dim newWidth As Long '* Scale Width
    Dim newHeight As Long '* Scale Height
    newWidth = 4096
    newHeight = newWidth / ar
    
    ' Create new temporary presentation to add generated images as slides
    Dim oPresTmp As Presentation
    ' Create it as not visible
    Set oPresTmp = Presentations.Add(msoFalse)
    ' Copy page size from the source presentation
    With oPresTmp.PageSetup
        .SlideHeight = oPres.PageSetup.SlideHeight
        .SlideWidth = oPres.PageSetup.SlideWidth
    End With
    Dim oSlideNew As Slide '* Slide Object
    Dim oPic As Shape

    ' Export slides
    Dim sImageName As String
    Dim oSlide As Slide '* Slide Object
    Dim img_format As String
    img_format = "png"
    For Each oSlide In oPres.Slides
        With oSlide
            ' If slide is not hidden
            If (.SlideShowTransition.Hidden = msoFalse) Then
                ' Export slide
                sImageName = sImagePath & "\" & sPrefix & "-" & Format$(.SlideIndex, "000") & "." & img_format
                .Export sImageName, img_format, newWidth, newHeight
                ' Add it to the temporary presentation
                Set oSlideNew = oPresTmp.Slides.Add(oPresTmp.Slides.Count + 1, ppLayoutBlank)
                Set oPic = oSlideNew.Shapes.AddPicture(FileName:=sImageName, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=0, _
                    Top:=0, _
                    Width:=-1, _
                    Height:=-1)
                    ' width/height of -1 tells PPT to import the image at its "natural" size
            End If
        End With
    Next oSlide
    
    With oPresTmp
        ' Export temp presentation to pdf
        Dim sPDFName As String
        sPDFName = sImagePath & ".pdf"
        .ExportAsFixedFormat sPDFName, ppFixedFormatTypePDF, ppFixedFormatIntentPrint, msoFalse, _
            ppPrintHandoutVerticalFirst, ppPrintOutputSlides, msoFalse
        
        ' Close temp presentation
        .Saved = True
        .Close
    End With

Err_ImageSave:
    If Err <> 0 Then
        MsgBox Err.Description
    End If
End Sub

相关内容