我正在编写一个宏,它允许我将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
发布于 2022-01-17 15:46:00
另一种方法是将演示文稿保存到新名称,删除所有未选中的幻灯片,然后再次保存。
这是最基本的。您需要修改它以适应您自己的文件命名约定。您还可以存储原始演示文稿的名称,并在以后重新打开它,如果您愿意的话。
Sub Test()
Dim x As Long
Dim cSlides As New Collection
With ActivePresentation
' Save to a new file name
.SaveAs "c:\temp\newfile.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
https://stackoverflow.com/questions/70723697
复制相似问题