[原创]原创工具---PowerPoint转换为WORD文件！

wenz

该加载宏在XP下也是没有问题的

chenwintek

OK999OK

好！欢迎大家测试，提出修改建议！

ncow

好也,当然要收藏

sallet

以下是引用OK999OK在2005-8-12 14:26:04的发言：

最新修改版本 : 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 Sub Public 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.Text End 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 = True End Sub

思路很清楚，不过保持格式在WORD里，还是需要手工调整，楼主可不可以加条语句一次性调整一级标题，二级标题，正文等。

series

很好，谢谢！·

草原上的狼

8错，谢谢。

mqcwl

不能在POWERPOINT2003中运行。

lkyzhs

一样的东西两边搬家没意思！！！！！

andy_zjhzd3m

Good, 非常有用, 只是字体要调整过,不过安啦, 已经很满足了的