用VBS将PPT转为图片

'使用方法：把ppt文件拖放到该文件上。
'机器上要安装Powerpoint程序
On Error Resume Next
Set ArgObj = WScript.Arguments
pptfilepath = ArgObj()
imgType = InputBox("输入导出文件的格式，可以是jpg,png,bmp,gif","输入导出文件的格式","png")
If imgType = "" Or (LCase(imgType)<>"jpg" And LCase(imgType)<>"png" And LCase(imgType)<>"bmp" And LCase(imgType)<>"gif") Then
    imgType = "png"
    MsgBox "输入不正确，以png格式输出"
End If
imgW = InputBox("输入导出图像的宽度","输入导出图像的宽度","")
If imgW = "" Or IsNumeric(imgW)=False Then
    imgW =
    MsgBox "输入不正确,程序使用默认值:640"
End If
imgH = InputBox("输入导出图像的高度","输入导出图像的高度","")
If imgH = "" Or IsNumeric(imgH)=False Then
    imgH = imgW*0.75
    MsgBox "输入不正确,程序使用默认值:"&imgH
End If 

Call Form_Load(pptfilepath,imgType)
Private Sub Form_Load(Filepath,format)
    If format = "" Then
        format = "gif"
    End If
    Folderpath = Left(Filepath,Len(Filepath)-)
    If LCase(Right(Filepath,))<>".ppt" Then
        Call ConvertPPT(Filepath,Folderpath&".ppt")
    End If
    Filepath = Folderpath&".ppt"
    CreateFolder(Folderpath)
    Set ppApp = CreateObject("PowerPoint.Application")
    Set ppPresentations = ppApp.Presentations
    Set ppPres = ppPresentations.Open(Filepath, -, , )
    Set ppSlides = ppPres.Slides   

    For i =  To ppSlides.Count   

        iname = ""&i
        iname = Right(iname,)'取四位数
        Call ppSlides.Item(i).Export(Folderpath&"\"&iname&"."&format, format, imgW, imgH)
    Next  

    Set ppApp = Nothing
    Set ppPres = Nothing
End Sub  

Function CreateFolder(Filepath)
    Dim fso, f
    On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(Filepath) Then
        Set f = fso.CreateFolder(Filepath)
    End If
    CreateFolder = f.Path
    Set fso = Nothing
    Set f = Nothing
End Function  

Sub ConvertPPT(FileName1, FileName2)
    Dim PPT
    Dim Pres
    Set PPT = CreateObject("PowerPoint.Application")
    Set Pres = PPT.Presentations.Open(FileName1, False, False, False)
    Pres.SaveAs FileName2, , True
     Pres.Close
    PPT.Quit
     Set Pres = Nothing
    Set PPT = Nothing
End Sub