zoukankan      html  css  js  c++  java
  • 用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  
  • 相关阅读:
    已解决[Authentication failed for token submission,Illegal hexadecimal charcter s at index 1]
    远程快速安装redis和远程连接
    远程快速安装mysql
    Swiper的jquery动态渲染不能滑动
    微服务架构攀登之路(三)之gRPC入门
    微服务架构攀登之路(二)之RPC
    微服务架构攀登之路(一)之微服务初识
    Go语言中new和make的区别
    Go语言实战爬虫项目
    Go语言系列(十一)- 日志收集系统架构
  • 原文地址:https://www.cnblogs.com/fm168/p/3875787.html
Copyright © 2011-2022 走看看