如何自动化生成PPT缩略图？

Question

这几年积累了好多PPT模板，想做成像那些PPT模板网站那样的缩略图，在网上找了很久，尝试了很多关键字：

• PPT生成缩略图 批量
• PPT转图片
• 批量生成PPT缩略图
• ......

都没有找到相应的办法，这个倒是能实现PPT转长图的功能，但是生成的图片和PPT一样大，太占用空间了呃……

Answer 1

搜到的代码,可能得自己改一下.

'' 导出当前文件夹下所有 PowerPoint 演示文稿的第一张幻灯片
'' 并以图形文件格式保存在当前文件夹下
'' 变量声明和初始化
Dim wShell, pptApp, fso, folder, file, slide, outFile
Set wShell = WScript.CreateObject("WScript.Shell")
'' 获取当前文件夹
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(wShell.CurrentDirectory)
Set fso = Nothing
'MsgBox(folder.Path)
'' 打开 PowerPoint 应用程序
Set pptApp = WScript.CreateObject("PowerPoint.Application")
pptApp.Activate
'' 遍历当前文件夹下所有文件
For Each file in folder.Files
  '' 如果文件扩展名为 ppt（根据实际需要和 PowerPoint 程序版本，还可以是 pps, pptx 等）
  If UCase(Mid(file.Name, InstrRev(file.Name, ".") + 1)) = "PPT" Then 
'    MsgBox(file.Name)
    '' 设置输出文件名，此处使用原演示文稿名称
    outFile = Trim(Left(file.Path, InStrRev(file.Path, ".") - 1)) & ".jpg"
'    MsgBox(outFile)
    pptApp.Presentations.Open file.Path
    '' 此处只需要第一张幻灯片
    Set slide = pptApp.ActivePresentation.Slides(1)
    '' 如果需要导出多张幻灯片，使用如下循环
'     For Each slide in pptApp.ActivePresentation.Slides.Range(1)
        '' Export(String FileName, String FilterName, Long ScaleWidth, Long ScaleHeight)
        '' FilterName 可以为 gif, jpg, png, bmp, wmf, tif 等。
        slide.Export outFile, "jpg", 320, 240
'     Next
    pptApp.Presentations(1).Close
  End If
Next
'' 退出 PowerPoint 应用程序
pptApp.Quit
'' 清理对象
Set pptApp = Nothing
Set wShell = Nothing 

原文:https://blog.csdn.net/laobai_...
里面提到的那个页面打不开了,很遗憾