请选择 进入手机版 | 继续访问电脑版

中国拿破仑论坛

 找回密码
 入伍
新兵指南:让新兵更快熟悉论坛转载文章请注明作者/译者及出处@napolun.com邮箱自助申请
近卫军名将 - 赤胆忠心的“圣贤”德鲁奥 电影《滑铁卢》DVD-5一张钱老神作 THE CAMPAIGNS OF NAPOLEON
拿破仑所著小说《克利松与欧仁妮》波兰军团的创始者——东布罗夫斯基 路易斯-皮雷•蒙布伦和他的骑兵生涯
查看: 5897|回复: 10

[软件] 【PPT转WORD】 无敌教程及脚本程序下载

[复制链接]
发表于 2010-1-8 12:39:05 | 显示全部楼层 |阅读模式
大家通常使用一个麻烦的软件ppt Convert to doc.exe来转幻灯片,虽然有的人以为它已经很简单了,但是我还有更加简单的方式!

想过滤图片图表,只留文字的方法:

PPT文件打开,文件/另存为/大纲,rtf文件,然后你可以打开新存的rtf文件,发现想要的文字全在里面。

想转换为保留图片图表的文档的方法:

在d盘新建一个命名为“ppt”的文件夹,把想转换的文件放里——最好只放一个!

然后双击运行VBS程序。你可以看到在d盘ppt文件夹内已经生成word文档,按照页码保留了原先ppt每一页的文字和图片、图表。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?入伍

x
回复

使用道具 举报

 楼主| 发表于 2010-1-8 12:39:41 | 显示全部楼层

脚本程序

strComputer = "."

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

on error resume next
'____________________________设置区______________________________


'vis:可视性

'dia:有停顿

'zoomm:对象缩放比例
'fgf:显示幻灯片号码

vis=1

dia=1

fgf=1
zoomm=0.7

'1真0假

'____________________________设置区末______________________________

n=1

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

msgbox "此脚本可以批量将ppt文件中的文本转换为word文件。图片、表格等内容不跳过" & vbcrlf & "使用时请把所有要转换的ppt文件复制到目录d:\ppt\下。双击运行此文件即可。" & vbcrlf & "运行此脚本需要本机上安装了office"  

'创建一个word对象

Set objWord = CreateObject("Word.Application")

'创建一个ppt对象

Set pptApp = CreateObject("PowerPoint.application")

'获得d:\ppt\目录下的文件集合

Set FileList = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='d:\ppt'} Where " & "ResultClass = CIM_DataFile")

For Each objFile In FileList

'如果文件的扩展名是ppt

If objFile.Extension = "ppt" Then

if vis=1 or dia=1 then

pptApp.visible = true

else

pptApp.visible = false

end if

'打开这个ppt文件

Set pptSelection = pptApp.Presentations.Open("d:\ppt\" & objFile.FileName & "." & objFile.Extension)

'如果想让脚本处理得快些,把下面一行改为“objWord.Visible = false”,不推荐。

if vis=1 or dia=1 then

objWord.Visible = true

else

objWord.Visible = false

end if

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

Set objDoc = objWord.Documents.Add()

Set objSelection = objWord.Selection

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

For i = 1 To pptSelection.Slides.Count

'从每一张ppt的第一个文本框开始循环,Shapes.Count,即每张幻灯片中文本框的数量

For j = 1 To pptSelection.Slides(i).Shapes.Count

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

if i =1 then

objSelection.Font.Name = "黑体"

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

objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text

objSelection.TypeParagraph()

objSelection.Font.Name = "宋体"

else

objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text

end if

if pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text="" then

pptSelection.Slides(i).Shapes(j).copy

objSelection.paste

Selection.InlineShapes(n).Height = Selection.InlineShapes(n).Height*zoomm

Selection.InlineShapes(n).Width = Selection.InlineShapes(n).Width *zoomm

objSelection.MoveRight

n=n+1

end if

'加一个回车

objSelection.TypeText vbcrlf

Next

if fgf =1 then

objSelection.Font.Name = "黑体"

objSelection.TypeText "p"&i

objSelection.TypeText vbcrlf

objSelection.Font.Name = "宋体"

  

end if

next

  

'关闭这个ppt文件

pptSelection.close

'保存word文件。

objDoc.SaveAs("d:\ppt\" & objFile.FileName & ".doc")

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

objDoc.close

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

if dia=1 then

msgbox "转换后的word已保存在d:\ppt\" & objFile.FileName & ".doc"

end if

else  

'没有ppt文件

if dia=1 then

msgbox "错误:d:\ppt\下没有发现ppt文件!"

end if

End if

Next

pptApp.quit  
'在winxp professional下测试通过
回复 支持 反对

使用道具 举报

 楼主| 发表于 2010-1-8 12:40:46 | 显示全部楼层
以上程序如果持有疑虑,请自行复制到记事本,该后缀名为“.vbs”。

我发布的教程都是傻瓜教程,一学就会。
回复 支持 反对

使用道具 举报

发表于 2010-1-9 12:45:42 | 显示全部楼层
看来我连傻瓜都不如了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2010-1-11 12:45:49 | 显示全部楼层
看一楼,和三楼,就明白了
回复 支持 反对

使用道具 举报

发表于 2010-1-11 20:28:22 | 显示全部楼层

回复 5# 的帖子

看来昨天真是蓝哥
回复 支持 反对

使用道具 举报

 楼主| 发表于 2010-1-11 20:30:04 | 显示全部楼层
很简单的,如果我是假的,怎么会在签名上说“我的qq被盗用”!?
回复 支持 反对

使用道具 举报

发表于 2010-1-11 20:32:53 | 显示全部楼层

回复 7# 的帖子

嘿嘿,搞错了啦
回复 支持 反对

使用道具 举报

 楼主| 发表于 2010-1-11 20:41:38 | 显示全部楼层


“我心领了,谢谢您”
回复 支持 反对

使用道具 举报

发表于 2010-1-11 20:47:43 | 显示全部楼层

回复 9# 的帖子

................................................
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入伍

本版积分规则

小黑屋|手机版|Archiver|中国拿破仑 ( 京ICP备05046168号 )

GMT+8, 2019-11-13 00:57 , Processed in 0.142103 second(s), 17 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表