2

我有一个将我指定的幻灯片保存为 PNG 的代码：

Dim userName As String
userName = Slide322.TextBox1.Text

'Save slide

ActivePresentation.Slides(302).Export _
        filename:="C:\Users\Jessica\Dropbox\Uni\DISSERTATION\Questionnaire\Tools\Results\" & userName & ".png", FilterName:="PNG"

但是，我想将幻灯片另存为 .PPT，以便以后打开它并编辑该幻灯片上的文本。我曾尝试使用 .SaveAs 语法，但每次都会收到一条错误消息，而且它无法识别任何“保存”类型的表达式。

我已经搜索并搜索了这个问题的答案......有人可以帮忙吗？

4

5 回答 5

5

尝试：

ActivePresentation.Slides(1).Export "c:\temp\slide1.ppt", "PPT"

选择：

使用 SaveCopy 保存演示文稿的副本 打开保存的副本（带或不带窗口） 删除所有幻灯片，直到要保留的那张幻灯片 删除要保留的幻灯片之后的所有幻灯片 再次保存。关闭演示文稿

像这样：

Sub TestMe()
    SaveSlide 5, "c:\temp\slide5.pptx"
End Sub

Sub SaveSlide(lSlideNum As Long, sFileName As String)

    Dim oTempPres As Presentation
    Dim x As Long

    ActivePresentation.SaveCopyAs sFileName
    ' open the saved copy windowlessly
    Set oTempPres = Presentations.Open(sFileName, , , False)

    For x = 1 To lSlideNum - 1
        oTempPres.Slides(1).Delete
    Next

    ' What was slide number lSlideNum is now slide 1
    For x = oTempPres.Slides.Count To 2 Step -1
        oTempPres.Slides(x).Delete
    Next

    oTempPres.Save
    oTempPres.Close

End Sub

显然，您需要添加一些安全绳......不要尝试导出 12 张幻灯片演示文稿的第 15 张幻灯片等。

于 2013-04-16T20:54:59.643 回答
0

子拆分文件（）

Dim lSlidesPerFile As Long
Dim lTotalSlides As Long
Dim oSourcePres As Presentation
Dim otargetPres As Presentation
Dim sFolder As String
Dim sExt As String
Dim sBaseName As String
Dim lCounter As Long
Dim lPresentationsCount As Long     ' how many will we split it into
Dim x As Long
Dim lWindowStart As Long
Dim lWindowEnd As Long
Dim sSplitPresName As String

On Error GoTo ErrorHandler

Set oSourcePres = ActivePresentation
If Not oSourcePres.Saved Then
    MsgBox "Please save your presentation then try again"
    Exit Sub
End If

lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
lTotalSlides = oSourcePres.Slides.Count
sFolder = ActivePresentation.Path & "\"
sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)

If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
    lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
Else
    lPresentationsCount = lTotalSlides \ lSlidesPerFile
End If

If Not lTotalSlides > lSlidesPerFile Then
    MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
    Exit Sub
End If

For lCounter = 1 To lPresentationsCount

    ' which slides will we leave in the presentation?
    lWindowEnd = lSlidesPerFile * lCounter
    If lWindowEnd > oSourcePres.Slides.Count Then
        ' odd number of leftover slides in last presentation
        lWindowEnd = oSourcePres.Slides.Count
        lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
    Else
        lWindowStart = lWindowEnd - lSlidesPerFile + 1
    End If

    ' Make a copy of the presentation and open it
    sSplitPresName = sFolder & sBaseName & _
           "_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
    oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
    Set otargetPres = Presentations.Open(sSplitPresName, , , True)

    With otargetPres
        For x = .Slides.Count To lWindowEnd + 1 Step -1
            .Slides(x).Delete
        Next
        For x = lWindowStart - 1 To 1 Step -1
            .Slides(x).Delete
        Next
        .Save
        .Close
    End With

Next    ' lpresentationscount

NormalExit：Exit Sub ErrorHandler：MsgBox“遇到错误” Resume NormalExit End Sub

于 2013-07-02T10:49:07.347 回答
0

您可以尝试以下代码：

  1. 创建新的演示文稿
  2. 将幻灯片复制到它

  3. 保存和关闭新的演示文稿。

    Sub SaveSeparateSlide()

    Dim curPres As Presentation
    Set curPres = ActivePresentation
    Dim newPres As Presentation
    Set newPres = Presentations.Add

'change slide number here:
curPres.Slides(1).Copy
newPres.Slides.Paste

    'change your path and name here:
    newPres.SaveAs "single slide presentation.pptx"
    newPres.Close
End Sub

您将需要稍微调整该代码，但我认为您会应付:)

于 2013-04-16T16:54:33.173 回答
0 
ActivePresentation.Slides(1).Export "1.ppt", "PPT"

上面的代码将 Slide#1 导出为“旧”类型的 ppt 格式。以下 2 个宏中的第 2 个可以以更兼容的“新”pptx 格式保存副本。它实际上是史蒂夫的两种方法的混合。但它不会打扰删除其余的幻灯片。

Sub SaveEachPage2PPT()

Dim sld As Slide
Dim l#

With ActivePresentation
    For Each sld In .Slides
        l = l + 1
        sld.Export .Path & "\" & l & ".ppt", "PPT"
    Next sld
End With
End Sub

Sub SaveEachPage2PPTX()

Dim sld As Slide
Dim l#
Dim ppt As Presentation
Dim pptFile$

With ActivePresentation
    For Each sld In .Slides
        l = l + 1
        pptFile = .Path & "\" & l & ".ppt"
        sld.Export pptFile, "PPT"
        Set ppt = Presentations.Open(pptFile, , , False)
        ppt.SaveCopyAs pptFile & "x", ppSaveAsOpenXMLPresentation
        ppt.Close
        Kill pptFile
    Next sld
End With
If Not ppt Is Nothing Then Set ppt = Nothing

End Sub
于 2018-12-10T06:03:10.573 回答
0

以下脚本将帮助您将演示文稿的各个幻灯片保存为单独的 pptx 文件。我修改@Steve Rindsberg了代码来实现这一点。

只需在代码中更改以下内容

  1. 更改K:\PRESENTATION_YOU_ARE_EXPORTING.pptx您要导出的演示文稿的文件路径。

  2. 更改K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\应保存导出演示文稿的文件夹路径。

  3. 请记住在步骤 2 中的文件夹路径末尾添加 \。

    Sub ExportSlidesToIndividualPPPTX()
  Dim oPPT As Presentation, oSlide As Slide
  Dim sPath As String
  Dim oTempPres As Presentation
  Dim x As Long

  ' Location of PPTX File
  Set oPPT = Presentations.Open(FileName:="K:\PRESENTATION_YOU_ARE_EXPORTING.pptx")
  ' Location Where Individual Slides Should Be Saved
  ' Add \ in the end
  sPath = "K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\"

  For Each oSlide In oPPT.Slides
     lSlideNum = oSlide.SlideNumber
     sFileName = sPath & "Slide - " & lSlideNum & ".pptx"
     oPPT.SaveCopyAs sFileName
     ' open the saved copy windowlessly
     Set oTempPres = Presentations.Open(sFileName, , , False)

     ' Delete all slides before the slide you want to save
     For x = 1 To lSlideNum - 1
         oTempPres.Slides(1).Delete
     Next

     ' Delete all slides after the slide you want to save
     For x = oTempPres.Slides.Count To 2 Step -1
         oTempPres.Slides(x).Delete
     Next

     oTempPres.Save
     oTempPres.Close

  Next

  Set oPPT = Nothing

End Sub
于 2018-12-19T04:34:18.863 回答