|
|
将下面代码复制下来，另存为 convert.vbs。使用时请把所有要转换的 ppt 文件复制到目录 c:下。双击运行此脚本文件即可。 ================================================================
strComputer = "." on error resume next Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!" & strComputer & "rootcimv2") msgbox "此脚本可以批量将 ppt 文件中的文本转换为 word 文件。图片、表格等内容则自动跳过" & vbcrlf & "使用时请把所有 要转换的 ppt 文件复制到目录 c:下。双击运行此文件即可。" & vbcrlf & "运行此脚本需要本机上安装了 office" Set objWord = CreateObject("Word.Application") Set pptApp = CreateObject("PowerPoint.application") Set FileList = objWMIService.ExecQuery _ ("ASSOCIATORS OF {Win32_Directory.Name='c:'} Where " _ & "ResultClass = CIM_DataFile") For Each objFile In FileList If objFile.Extension = "ppt" Then pptApp.visible = true Set pptSelection = pptApp.Presentations.Open("c:" & objFile.FileName & "." & objFile.Extension) objWord.Visible = true Set objDoc = objWord.Documents.Add() Set objSelection = objWord.Selection For i = 1 To pptSelection.Slides.Count For j = 1 To pptSelection.Slides(i).Shapes.Count if i =1 then objSelection.Font.Name = "黑体" objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text
objSelection.TypeParagraph() objSelection.Font.Name = "宋体" end if objSelection.TypeText objSelection.TypeText Next next pptSelection.close objDoc.SaveAs("c:" & objFile.FileName & ".doc") objDoc.close msgbox "转换后的 word 已保存在 c:" & objFile.FileName & ".doc" else 'msgbox "错误：c:下没有发现 ppt 文件！" End If Next pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text vbcrlf
pptApp.quit |
|
