VBA代码将单个幻灯片另存为.ppt

时间:2013-04-16 16:40:55

标签: save powerpoint-vba

我有一个代码,将我指定的幻灯片保存为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语法,但每次都会收到一条错误消息,它不会识别任何“保存”类型的表达式。

我已经搜索过,并搜索了这个答案......有人可以帮忙吗?

5 个答案:

答案 0 :(得分: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等。

答案 1 :(得分: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
    
  4. 你需要稍微调整一下这段代码,但我认为你会应对:)

答案 2 :(得分:0)

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

NormalExit:     退出子 的ErrorHandler:     MsgBox"遇到错误"     恢复NormalExit 结束子

答案 3 :(得分: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

答案 4 :(得分:0)

以下脚本将帮助您将演示文稿的各个幻灯片另存为单独的pptx文件。我修改了 <dependency> <groupId>com.oracle</groupId> <artifactId>ojdbc6</artifactId> <version>11.2.0</version> </dependency> 代码以实现此目的。

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

  1. 使用您要导出的演示文稿的文件路径更改@Steve Rindsberg

  2. 使用保存导出的演示文稿的文件夹路径更改K:\PRESENTATION_YOU_ARE_EXPORTING.pptx

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

    K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\