我有一个将我指定的幻灯片保存为 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 语法，但每次都会收到一条错误消息，而且它无法识别任何“保存”类型的表达式。
我已经搜索并搜索了这个问题的答案...有人可以帮忙吗？
【问题讨论】：
标签： vba save powerpoint
试试：
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 张幻灯片等。
【讨论】：
您可以尝试以下代码：
保存并关闭新演示文稿。
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
你需要稍微调整一下代码，但我认为你会应付的:)
【讨论】：
Sub SplitFile()
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
正常退出： 退出子 错误处理程序： MsgBox "遇到错误" 恢复正常退出 结束子
【讨论】：
ActivePresentation.Slides(1).Export "1.ppt", "PPT"
以上代码将幻灯片#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
【讨论】：
以下脚本将帮助您将演示文稿的各个幻灯片保存为单独的 pptx 文件。我修改了@Steve Rindsberg 代码来实现这一点。
只需在代码中更改以下内容
将K:\PRESENTATION_YOU_ARE_EXPORTING.pptx 更改为您要导出的演示文稿的文件路径。
将K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\ 更改为应保存导出演示文稿的文件夹路径。
记得在第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
【讨论】：