‘使用方法:把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
用VBS将PPT转为图片
时间: 2024-10-10 23:09:51