主页 / computer / 问题 / 1590890
Accepted
sancho.s ReinstateMonicaCellio
Asked: 2020-10-06 04:08:16 +0800 CST

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

  • 772

我有一个PowerPoint演示文稿。我想把它变成PDF。如果我保存副本并使用 PDF，我至少要避免两个问题：

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

  2. 我记得偶尔会看到（我现在无法复制太糟糕了）生成的 PDF 有轻微的排列问题。

避免这些问题的一种方法是将每张幻灯片导出为纯图像。我可以处理那条路线，但有两点使它有点麻烦，我的意思是摆脱：

  1. 从 Powerpoint 导出为 jpg（例如）时，没有选项可以避免导出隐藏的幻灯片（这可以在直接保存为 PDF 时完成）。

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

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

pdf microsoft-powerpoint

2 个回答

  1. 将演示文稿的副本另存为 PowerPoint 图片演示文稿。这将为您提供一个 PPTX，其中每张幻灯片都是原始幻灯片的图像。

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

    检查以确保隐藏在原件中的幻灯片仍然隐藏在保存的图片演示中。如果没有，您需要在保存为 PDF 之前再次隐藏它们。

    • 2
  2. Best Answer

    在史蒂夫林茨伯格的回答中交换评论后，我得出结论，要走的路是使用 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
    • 1

相关问题