VBSCRIPT PPT转换脚本

Posted 2023-02-24

【中文标题】VBSCRIPT PPT转换脚本

【英文标题】：VBSCRIPT PPT conversion script

【发布时间】：2013-11-08 00:18:16

【问题描述】：

我正在尝试使用 VBSCRIPT 将 PPT 文件转换为 PPTX 文件。我已经很长时间没有使用 VB 并且对框架非常不熟悉。我正在尝试修改将 PPTX/PPT 转换为 PDF 的脚本，但是运气不佳。这是我到目前为止所得到的一个例子......

Option Explicit

Dim inputFile
Dim objPPT
Dim objPresentation
Dim objPrintOptions
Dim objFso
Dim pptf

If WScript.Arguments.Count <> 1 Then
    WriteLine "You need to specify input and output files."
    WScript.Quit
End If

inputFile = WScript.Arguments(0)

Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FileExists( inputFile ) Then
    WriteLine "Unable to find your input file " & inputFile
    WScript.Quit
End If



WriteLine "Input File:  " & inputFile

Set objPPT = CreateObject( "PowerPoint.Application" )

objPPT.Visible = True
objPPT.Presentations.Open inputFile

Set objPresentation = objPPT.ActivePresentation
objPresentation.SaveAs "out.pptx", Microsoft.Office.Interop.PowerPoint.PpSaveAsFileType.ppSaveAsOpenXMLPresentation

objPresentation.Close
ObjPPT.Quit

objPresentation.SaveAs 线周围变成梨形；显然它是非法的语法 - 但是我不确定这里的最佳路线。任何帮助将非常感激。此外，如果还有其他变量（或指向 api 文档的链接）用于转换 doc->docx 和 xls->xlsx。 提前致谢。

编辑： 我自己找到了解决方案；抱歉，我在发布几天后停止查看此线程。我找到了此代码的文档页面，并特别注意到了一个函数（convert2）：http://msdn.microsoft.com/en-us/library/office/ff743830.aspx

我会将下面的答案标记为答案；因为它首先出现（尽管我还没有测试过）。如果您有兴趣 - 这是我的代码； AFAIK 它只在各种 PowerPoint 格式之间转换（在任一方向）。另外仅供参考，我从另一个关于该主题的流行谷歌脚本修改了这个脚本；我改变的唯一一行是最后一行（convert2 mehtod）。无论如何...（也 - 这需要 Office 2010；根据文档）

用法： CSCRIPT scriptName.vbs C:\inputfileName.ppt C:\outputFileName.pptx

Option Explicit

Sub WriteLine ( strLine )
    WScript.Stdout.WriteLine strLine
End Sub

' http://msdn.microsoft.com/en-us/library/office/aa432714(v=office.12).aspx
Const msoFalse = 0   ' False.
Const msoTrue = -1   ' True.

' http://msdn.microsoft.com/en-us/library/office/bb265636(v=office.12).aspx
Const ppFixedFormatIntentScreen = 1 ' Intent is to view exported file on screen.
Const ppFixedFormatIntentPrint = 2  ' Intent is to print exported file.

' http://msdn.microsoft.com/en-us/library/office/ff746754.aspx
Const ppFixedFormatTypeXPS = 1  ' XPS format
Const ppFixedFormatTypePDF = 2  ' PDF format

' http://msdn.microsoft.com/en-us/library/office/ff744564.aspx
Const ppPrintHandoutVerticalFirst = 1   ' Slides are ordered vertically, with the first slide in the upper-left corner and the second slide below it.
Const ppPrintHandoutHorizontalFirst = 2 ' Slides are ordered horizontally, with the first slide in the upper-left corner and the second slide to the right of it.

' http://msdn.microsoft.com/en-us/library/office/ff744185.aspx
Const ppPrintOutputSlides = 1               ' Slides
Const ppPrintOutputTwoSlideHandouts = 2     ' Two Slide Handouts
Const ppPrintOutputThreeSlideHandouts = 3   ' Three Slide Handouts
Const ppPrintOutputSixSlideHandouts = 4     ' Six Slide Handouts
Const ppPrintOutputNotesPages = 5           ' Notes Pages
Const ppPrintOutputOutline = 6              ' Outline
Const ppPrintOutputBuildSlides = 7          ' Build Slides
Const ppPrintOutputFourSlideHandouts = 8    ' Four Slide Handouts
Const ppPrintOutputNineSlideHandouts = 9    ' Nine Slide Handouts
Const ppPrintOutputOneSlideHandouts = 10    ' Single Slide Handouts

' http://msdn.microsoft.com/en-us/library/office/ff745585.aspx
Const ppPrintAll = 1            ' Print all slides in the presentation.
Const ppPrintSelection = 2      ' Print a selection of slides.
Const ppPrintCurrent = 3        ' Print the current slide from the presentation.
Const ppPrintSlideRange = 4     ' Print a range of slides.
Const ppPrintNamedSlideShow = 5 ' Print a named slideshow.

' http://msdn.microsoft.com/en-us/library/office/ff744228.aspx
Const ppShowAll = 1             ' Show all.
Const ppShowNamedSlideShow = 3  ' Show named slideshow.
Const ppShowSlideRange = 2      ' Show slide range.

'
' This is the actual script
'

Dim inputFile
Dim outputFile
Dim objPPT
Dim objPresentation
Dim objPrintOptions
Dim objFso

If WScript.Arguments.Count <> 2 Then
    WriteLine "You need to specify input and output files."
    WScript.Quit
End If

inputFile = WScript.Arguments(0)
outputFile = WScript.Arguments(1)

Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FileExists( inputFile ) Then
    WriteLine "Unable to find your input file " & inputFile
    WScript.Quit
End If

If objFso.FileExists( outputFile ) Then
    WriteLine "Your output file (' & outputFile & ') already exists!"
    WScript.Quit
End If

WriteLine "Input File:  " & inputFile
WriteLine "Output File: " & outputFile

Set objPPT = CreateObject( "PowerPoint.Application" )

objPPT.Visible = True
objPPT.Presentations.Open inputFile

Set objPresentation = objPPT.ActivePresentation
Set objPrintOptions = objPresentation.PrintOptions

objPrintOptions.Ranges.Add 1,objPresentation.Slides.Count
objPrintOptions.RangeType = ppShowAll

' Reference for this at http://msdn.microsoft.com/en-us/library/office/ff746080.aspx
objPresentation.convert2(output)

objPresentation.Close
ObjPPT.Quit

【问题讨论】：

我认为使用 VBA 宏用于 powerpoint 而不是独立的 VB 脚本会更容易..

也可以查看technet.microsoft.com/en-us/library/…

谢谢；我尝试了这些 - 但一个小时后没有发现任何即将发生的事情或......

【参考方案1】：

通常您会在 PowerPoint 中使用ExportAsFixedFormat(...) 执行此操作。既然选择了VBS，就必须使用SaveAs(...)。

我假设您还希望能够将 ppt/pptx 批量转换为 pdf，而不是一个一个指定完整的文件名...

Option Explicit

'http://msdn.microsoft.com/en-us/library/office/bb251061(v=office.12).aspx
Const ppSaveAsPDF = 32

Dim oFSO ' Public reference to FileSystemObject
Dim oPPT ' Public reference to PowerPoint App

Main

Sub Main()
    Dim sInput

    If wscript.Arguments.Count <> 1 Then
        Wscript.Echo "You need to specify input and output files."
        wscript.Quit
    End If

    ' PowerPoint version must be 12 or later (PowerPoint 2007 or later)
    Set oPPT = CreateObject("PowerPoint.Application")
    If CDbl(oPPT.Version) < 12 Then
        Wscript.Echo "PowerPoint version must be 2007 or later!"
        oPPT.Visible = True
        oPPT.Quit
        Set oPPT = Nothing
        wscript.Quit
    End If
    ' Store Input Argument and detect execute mode (single file / Folder batch mode)
    sInput = wscript.Arguments(0)
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If IsPptFile(sInput) Then
        PPT2PDF sInput
    ElseIf oFSO.FolderExists(sInput) Then
        Wscript.Echo "Batch Start: " & Now
        Wscript.Echo "Root Folder: " & sInput
        BatchPPT2PDF sInput
    Else
        Wscript.Echo """" & sInput & """ is not a PPT file or Folder!"
    End If
    ' Close PowerPoint app if no other presentations are opened
    If oPPT.Presentations.Count = 0 Then oPPT.Quit
    Set oPPT = Nothing
    Set oFSO = Nothing
End Sub

Private Sub BatchPPT2PDF(sFDR)
    Dim oFDR, oFile
    Wscript.Echo String(50, Chr(151))
    Wscript.Echo "Processing Folder: " & sFDR
    For Each oFile In oFSO.GetFolder(sFDR).Files
        If IsPptFile(oFile.Name) Then
            PPT2PDF(oFile)
        End If
    Next
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        BatchPPT2PDF oFDR
    Next
End Sub

Private Function IsPptFile(sFile)
    IsPptFile = (InStr(1, Right(sFile, InStrRev(sFile, ".")), "ppt") > 0)
End Function

Private Sub PPT2PDF(sFile)
    On Error Resume Next
    Dim sPDF, oPres
    sPDF = Left(sFile,InstrRev(sFile,".")) & "pdf"
    Set oPres = oPPT.Presentations.Open(sFile, True, False, False) ' Read Only, No Title, No Window
    Err.Clear
    oPres.SaveAs sPDF, ppSaveAsPDF
    oPres.Close
    Set oPres = Nothing
    If Err.Number = 0 Then
        Wscript.Echo "OK" & vbTab & sPDF
    Else
        Wscript.Echo "X" & vbTab & sPDF & " [ERR " & Err.Number & ": " & Err.Description & "]"
        Err.Clear
    End If
End Sub