[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

VBS如何访问、修改PowerPoint(PPT)文档?

哪位手上有用VBS对PowerPoint(PPT)文档进行常见操作(访问、修改d等)的教程或者例子,能否分享一下?多谢!

google、论坛搜索了半天,只找到一个例子,希望能有更多的资料可以学习。
  1. '/////////////////////////////
  2. '/PowerPoint文件转图像脚本(ppt2img)
  3. '/作者:www.51windows.net,海娃
  4. '/使用方法:将此文件放在sendto文件中,然后在ppt文件上点右键,发送到,ppt2img.vbs中,输入要输出图像的格式,然后输入图像的宽与高,脚本会生成一个同名的文件,里面为生成的图像文件。
  5. '/机器上要安装Powerpoint程序
  6. '/////////////////////////////
  7. 'on error resume next
  8. Set ArgObj = WScript.Arguments
  9. pptfilepath = ArgObj(0)
  10. imgType = InputBox("输入导出文件的格式,可以是jpg,png,bmp,gif","输入导出文件的格式","png")
  11. if imgType = "" or (lcase(imgType)<>"jpg" and lcase(imgType)<>"png" and lcase(imgType)<>"bmp" and lcase(imgType)<>"gif") then
  12. imgType = "png"
  13. msgbox "输入不正确,以png格式输出"
  14. end if
  15. imgW = InputBox("输入导出图像的宽度","输入导出图像的宽度","640")
  16. if imgW = "" or isnumeric(imgW)=false then
  17. imgW = 640
  18. msgbox "输入不正确,程序使用默认值:640"
  19. end if
  20. imgH = InputBox("输入导出图像的高度","输入导出图像的高度","480")
  21. if imgH = "" or isnumeric(imgH)=false then
  22. imgH = imgW*0.75
  23. msgbox "输入不正确,程序使用默认值:"&imgH
  24. end if
  25. call Form_Load(pptfilepath,imgType)
  26. Private Sub Form_Load(Filepath,format)
  27. if format = "" then
  28. format = "gif"
  29. end if
  30. Folderpath = left(Filepath,len(Filepath)-4)
  31. if lcase(right(Filepath,4))<>".ppt" then
  32. call ConvertPPT(Filepath,Folderpath&".ppt")
  33. end if
  34. Filepath = Folderpath&".ppt"
  35. CreateFolder(Folderpath)
  36.     Set ppApp = CreateObject("PowerPoint.Application")
  37.     Set ppPresentations = ppApp.Presentations
  38.     Set ppPres = ppPresentations.Open(Filepath, -1, 0, 0)
  39.     Set ppSlides = ppPres.Slides
  40. For i = 1 To ppSlides.Count
  41. iname = "000000"&i
  42. iname = right(iname,4)'取四位数
  43. Call ppSlides.Item(i).Export(Folderpath&"\"&iname&"."&format, format, imgW, imgH)
  44. Next
  45. Set ppApp = Nothing
  46. Set ppPres = Nothing
  47. End Sub
  48. Function CreateFolder(Filepath)
  49. Dim fso, f
  50. on error resume next
  51. Set fso = CreateObject("Scripting.FileSystemObject")
  52. if not fso.FolderExists(Filepath) then
  53. Set f = fso.CreateFolder(Filepath)
  54. end if
  55. CreateFolder = f.Path
  56. set fso = Nothing
  57. set f = Nothing
  58. End Function
  59. Sub ConvertPPT(FileName1, FileName2)
  60.     Dim PPT
  61.     Dim Pres
  62.     Set PPT = CreateObject("PowerPoint.Application")
  63.     Set Pres = PPT.Presentations.Open(FileName1, False, False, False)
  64.     Pres.SaveAs FileName2, , True
  65.     Pres.Close
  66.     PPT.Quit
  67.     Set Pres = Nothing
  68.     Set PPT = Nothing
  69. End Sub
复制代码
我帮忙写的代码不需要付钱。如果一定要给,请在微信群或QQ群发给大家吧。
【微信公众号、微信群、QQ群】http://bbs.bathome.net/thread-3473-1-1.html
【支持批处理之家,加入VIP会员!】http://bbs.bathome.net/thread-67716-1-1.html

搜索PowerPoint.Application

TOP

返回列表