求写VBA法-PPT转为Word

晨晓之黎

用VBA法-PPT转为Word
PPT所有的文字转入word，比如PPT中文本框中的文字，表格里的文字，文本框组合里的文字等，不要图片，不要所有的格式，只要所有的纯文本

痛痛痛痛

将下面代码复制下来，另存为 convert.vbs。使用时请把所有要转换的 ppt 文件复制到目录 c:\下。双击运行此脚本文件即可。 ================================================================
strComputer = "." on error resume next Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 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

晨晓之黎

痛痛痛痛 发表于 2018-9-17 11:00
将下面代码复制下来，另存为 convert.vbs。使用时请把所有要转换的 ppt 文件复制到目录 c:\下。双击运行此 ...

谢谢你！今天才看到！