Convert PPT to image using vbs

Source: Internet
Author: User
'Usage: drag and drop the pptfile to the file. 'Install the PowerPoint program on the machine on error resume next set argobj = wscript. arguments pptfilepath = argobj (0) imgtype = inputbox ("format of the input and export file, which can be JPG, PNG, BMP, GIF", "format of the input and export file ", "PNG") if imgtype = "" or (lcase (imgtype) <> "jpg" and lcase (imgtype) <> "PNG" and lcase (imgtype) <> "BMP" and lcase (imgtype) <> "GIF") Then imgtype = "PNG" msgbox "input is incorrect, output "end if imgw = inputbox (" input and export image width "," input and export image width "," 640 ") in PNG format ") if imgw = "" Or isnumeric (imgw) = false then imgw = 640 msgbox "is incorrect, the program uses the default value: 640 "end if imgh = inputbox (" Enter the height of the exported image "," Enter the height of the exported image "," 480 ") if imgh =" "Or isnumeric (imgh) = false then imgh = imgw * 0.75 msgbox "incorrect input. The program uses the default value:" & 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) 'count the four-digit 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) Pres. saveas filename2, true Pres. close PPT. quit set pres = nothing set PPT = nothing end sub

 

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.