VBA:为什么SlideRange.Export只导出单个幻灯片



我正在编写一个宏,该宏允许我将PowerPoint幻灯片区域导出到新文件。我正在使用SlideRange.Export函数。

你能就为什么宏当前只导出单个幻灯片而不是整个选择提供建议吗?

Sub SaveSlideSelectionPPT()
Dim shortFile As String
Dim longFile As String
Dim nameOnly As String
Dim answer As Integer
Dim i As Integer
Dim mySlides As SlideRange

'Defining parameters
Set objFso = CreateObject("Scripting.FileSystemObject")
Set mySlides = ActiveWindow.Selection.SlideRange
nameOnly = objFso.GetBaseName(ActivePresentation.Name) & "_Excerpt"
shortFile = ActivePresentation.Path & "" & nameOnly
longFile = shortFile & ".pptx"
i = 1
'Checking if file exists
While objFso.FileExists(longFile)
nameOnly = objFso.GetBaseName(ActivePresentation.Name) & "_Excerpt" & i
shortFile = ActivePresentation.Path & "" & nameOnly
longFile = shortFile & ".pptx"
i = i + 1
Wend
'Creating file
mySlides.Export shortFile, "PPTX"
Set newPres = Presentations.Open(longFile)
Set objFso = Nothing
End Sub

另一种方法是将演示文稿保存为新名称,删除所有未选中的幻灯片,然后再次保存。

以下是基础知识。您需要对此进行修改,以适应您自己的文件命名约定。您也可以存储原始演示文稿的名称,然后如果愿意,可以重新打开它。

Sub Test()
Dim x As Long
Dim cSlides As New Collection

With ActivePresentation

' Save to a new file name
.SaveAs "c:tempnewfile.pptx"

' Collect all of the UN-selected slides
For x = .Slides.Count To 1 Step -1
If Not IsSelected(.Slides(x).SlideIndex, ActiveWindow.Selection.SlideRange) Then
cSlides.Add .Slides(x)
End If
Next
End With
' Delete the collected, UN-selected slides
For x = cSlides.Count To 1 Step -1
cSlides(x).Delete
Next

' Save the modified presentation
ActivePresentation.Save

End Sub
Function IsSelected(lSlideIndex As Long, oSlideRange As SlideRange) As Boolean
' Returns True if the slide at index lSlideIndex in the selected sliderange is selected
Dim oSl As Slide
Dim x As Long

For x = 1 To oSlideRange.Count
If oSlideRange(x).SlideIndex = lSlideIndex Then
IsSelected = True
Exit Function
End If
Next
End Function

最新更新