PPT转Word脚本程序

'在C盘根目录下新建一个名为ppt的文件夹，将要转换的文件拷进去，然后再新建一个gif文件夹，路径为C:\ppt\gif。将这段代码保存为后缀名vbs的脚本文件，双击执行即可。

'简单的ppt效果较好，如果图片较多，则顺序会出错，如果图片较复杂，例如有许多部分组合而成，则效果很差

'绑定到本地计算机
strComputer = "."
'如果发生错误，继续执行
on error resume next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

'创建一个word对象
Set objWord = CreateObject("Word.Application")
'创建一个ppt对象
Set pptApp = CreateObject("PowerPoint.Application")

Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='c:\ppt'} Where " _
        & "ResultClass = CIM_DataFile")
For Each objFile in FileList
If objFile.Extension = "ppt" Then
pptApp.visible = True
pptApp.WindowState = 2
objWord.visible = True
'objWord.WindowState = 2
'打开ppt文件
Set pptSelection = pptApp.Presentations.Open("c:\ppt\" & objFile.FileName & "." & objFile.Extension)
'新建一个word文件，以保存ppt中的文本
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
'从ppt的第一页开始循环，Slides.Count即幻灯片的数量
For i =1 To pptSelection.Slides.Count
' objSelection.InsertBreak 2
'从每一张ppt的第一个文本框开始执行，Shapes.Count，即每张幻灯片中文本框的数量
   For j =1 To pptSelection.Slides(i).Shapes.Count
   '如果是文字的话拷贝文字
   If pptSelection.Slides(i).Shapes(j).TextFrame.HasText <>0 Then
    objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.Text
   Else
    '否则作为图片加入
    pptSelection.Slides(i).Shapes(j).Export "C:\ppt\gif\temp" & i &"_" & j& ".gif",ppShapeFormatGIF
    objDoc.InlineShapes.AddPicture "C:\ppt\gif\temp" & i &"_" & j& ".gif",False,True ,objSelection.Range
    objSelection.MoveDown 5,1,0
   End If  
   Next
   '加一个回车
   objSelection.TypeText vbcrlf
Next
'关闭ppt
pptSelection.close
'保存word文件
objDoc.SaveAs "c:\ppt\" & objFile.FileName & ".doc"
End If
Next
pptApp.quit