[原创]原创工具---PowerPoint转换为WORD文件！
最新修改版本 : PowerPoint2000转换为WORD文件！( 005.9.5)原来忘了加个调用的菜单，现在修改好了！加载宏 ppToWord2000.ppa (For Office2000)(office97,OfficeXP的用户请和我联系)效果：如果你的PP中的表格不多，主要是用文本框的话，基本可以完美的在WORD中再现！欢迎大家一起探讨！
Public Sub 保留格式PP转换为WORD() Call PowerPointToWord(True) MsgBox "转换完毕 ！(表格未做处理，请核对！)", vbInformation + vbOKOnly, "OK"End SubPublic Sub 删除格式PP转换为WORD() Call PowerPointToWord(False) MsgBox "转换完毕 ！(表格未做处理，请核对！)", vbInformation + vbOKOnly, "OK"End Sub
Private Sub PowerPointToWord(blStyle As Boolean)'-------------------------------------------------------------------------'作用：主要是把文本框、占位符、艺术字、图片、公式里面得内容转换到WORD里面。'图表、WORD表格、组织结构图等 OLE、表格暂时处理不好，主要是位置处理不好'保持格式: blStyle = False ，= True 删除格式'那位处理得好，麻烦通知一下：'msOfficeman@126.com'补充：PP2000中的表格是用文本框模拟的，在PP2003中此问题微软已经修正，故你可以修改本程序直接在PP2003中处理表格。'-------------------------------------------------------------------------On Error Resume Next Dim wdApp As Object Dim mr As SlideRange Dim tx As TextRange Dim i As Integer Dim iCount As Integer Dim iCunCount As Integer Dim iShapeType As Integer Set wdApp = CreateObject("Word.Application") wdApp.Visible = True 'wdApp.Application.ScreenUpdating = False '关闭屏幕刷新 wdApp.documents.Add Set mySlides = ActivePresentation.Slides.Range iCount = mySlides.Count For i = 1 To iCount DoEvents ActiveWindow.View.GotoSlide Index:=i iCunCount = ActiveWindow.Selection.SlideRange.Shapes.Count ' For j = 1 To iCunCount ActiveWindow.Selection.SlideRange.Shapes(j).Select iShapeType = ActiveWindow.Selection.SlideRange.Shapes(j).Type '1--自选图形 '7---公式 、（图表、WORD表格、组织结构图等 OLE） '17--文本框 19--表格 15--艺术字 14--占位符 '13---图片 ' Debug.Print iShapeType Select Case iShapeType Case 1, 14, 17 Set tx = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange tx.Select If tx.Text"" Then'----------------------------------------------------------------------If blStyle Then'保持格式 ActiveWindow.Selection.Copy ActiveWindow.Selection.Copy wdApp.documents(1).Activate wdApp.Selection.Paste'----------------------------------------------------------------------Else'删除格式 wdApp.documents(1).Range.InsertAfter tx.TextEnd If End If Case 7, 13, 15 '图片、公式 ActiveWindow.Selection.Copy 'wdApp.Documents(1).Activate wdApp.Selection.Paste Case 19 '表格不处理' ActiveWindow.Selection.Copy' wdApp.Activate' wdApp.Selection.Paste End Select Next j Next i' wdApp.Application.ScreenUpdating = TrueEnd Sub
应当是好帖。
但一帖双发在论坛是犯戒的，呵。 我试过了，无法加载下载的宏：ppToWord.ppa，是什么原因呢？是不是我的操作有误？
不好意思，我还只是个菜鸟！ 呵呵，只是想让大家引起注意，共同来完善它。无心犯戒啊。。。
楼上的用的哪个版本啊，我在OFICE2000测试没问题，别的没测试过。 关于加载的问题请看此帖：PPT学习论坛，顶一下40445
很不错的，比微软原来的导出功能更加强大，只是字号仍沿用Powerpiont中的，所以太大，设法进行一个换算，使24号对10号，28号对12号，依次，那就完美了。 加载宏了,怎么执行这个宏呀 鉴于2个论坛中有许多网友并不能同时都去，基于共享精神，原创的还是应该多鼓励为主啊。 多谢大家支持！尤其是5楼的鼓励及7楼的宽容！我会继续完善它的！关于字体的建议不错，我会考虑，你有什么好的转化算法可以讨论一下。
反对光说不练的！多做实事！ 我下载了还是不知道怎么用？ 还望楼主详细说明！ 楼上的OFFICE版本是2000的吗？2000的你直接双击是ppToWord文件就可以了，2000版本以上等我修改一下再传上来。