首页 > 代码库 > 用VBS将PPT转为图片

用VBS将PPT转为图片

使用方法:把ppt文件拖放到该文件上。   机器上要安装Powerpoint程序   On Error Resume Next  Set ArgObj = WScript.Arguments   pptfilepath = ArgObj(0)   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("输入导出图像的宽度","输入导出图像的宽度","640")    If imgW = "" Or IsNumeric(imgW)=False Then      imgW = 640       MsgBox "输入不正确,程序使用默认值:640"  End If  imgH = InputBox("输入导出图像的高度","输入导出图像的高度","480")    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)-4)       If LCase(Right(Filepath,4))<>".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, -1, 0, 0)       Set ppSlides = ppPres.Slides         For i = 1 To ppSlides.Count             iname = "000000"&i           iname = Right(iname,4)取四位数           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