2024年3月25日发(作者：)

我已开始提供了“文件——发送——Microsoft Office Word”这个方

法，但他反应这个方法不理想。之后我想起了以前收藏的一段脚本可以

批量把PPT文档转换为word文档，而且效果很好。在这里我把这段代码

和朋友们分享，希望给朋友们的学习和生活带去一些便利。

这是一段VB脚本代码。将下面的代码复制下来，保存为“把PPT转换

为”，可以放在任何位置。使用时把所有要转换的PPT文件复制

到目录C:（即C盘）下。双击运行此脚本文件即可进行转换了（注意：

电脑中必须装有Office）。

'绑定到本地计算机

strComputer = "."

'如果发生错误，继续执行

on error resume next

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!" & strComputer &

"rootcimv2")

msgbox "此脚本可以批量将ppt文件中的文本转换为word文件。图

片、表格等内容则自动跳过" & vbcrlf & "使用时请把所有要转换的ppt文

件复制到目录c:下。双击运行此文件即可。" & vbcrlf & "运行此脚本需

要本机上安装了office"

'创建一个word对象

Set objWord = CreateObject("ation")

'创建一个ppt对象

Set pptApp = CreateObject("ation")

'获得c:目录下的文件集合

Set FileList = ery _

("ASSOCIATORS OF {Win32_='c:'} Where " _

& "ResultClass = CIM_DataFile")

For Each objFile In FileList

'如果文件的扩展名是ppt

If ion = "ppt" Then

e = true

'打开这个ppt文件

Set pptSelection = ("c:" & me

& "." & ion)

'如果想让脚本处理得快些，把下面一行改为“e =

false”,不推荐。

e = true

'新建一个word，以保存ppt中的文本

Set objDoc = ()

Set objSelection = ion

'从ppt的第一页开始循环。即幻灯片的数量

For i = 1 To

'从每一张ppt的第一个文本框开始循环，，即每张幻灯

片中文本框的数量

For j = 1 To (i).

'如果是每页的第一行，就按标题处理，变成黑体字

if i =1 then

= "黑体"

'把文本框中的文字添加到word中

xt

(i).Shapes(j).

ragraph()

= "宋体"

end if

xt

(i).Shapes(j).

'加一个回车

xt vbcrlf

Next

next

'关闭这个ppt文件

'保存word文件。

("c:" & me & ".doc")

'如果不需要关闭word，把下面这一行删掉

'如果不想弹出消息框，把下面这一行删掉

msgbox "转换后的word已保存在c:" & me & ".doc"

else '没有ppt文件

'msgbox "错误：c:下没有发现ppt文件！"

End If

Next