power转word

1111aaaa

由于学习需要，要将ppt文件转换成doc文件，可是试了一下，并没有这个功能啊，应该怎么弄，有朋友知道吗？

1111aaaa

Attribute VB_Name = "PPT2Doc"
Sub PPT2Doc()
';
'; PPT2Doc Macro
'; Macro created 8/20/2003 by Harveer Singh
'; (c) Harveer Singh, 2003
'; Released under GPL http://www.opensource.org/licenses/gpl-license.html
'; Please maintain this copyright notice in all modified versions of this code
'; This code is provided ';as-is'; and no warranties are provided.

On Error Resume Next
'; Dummy Breakpoint - You might want to put a breakpoint here, since w/o breaking the code atleast once,
'; only first slide will be copied.
Debug.Print ""
'; Dummy Breakpoint Over
Dim aPPT As PowerPoint.Application
Dim i
Dim sld
Dim presName As String
Dim slideCount As Integer
Dim startTime, endTime As Date
Dim originalItalicStatus, originalBoldStatus As Boolean
   startTime = Time
   originalItalicStatus = Application.Selection.Font.Italic
   originalBoldStatus = Application.Selection.Font.Bold
   
   Set aPPT = CreateObject("PowerPoint.Application")
   presName = Left(aPPT.ActivePresentation.Name, Len(aPPT.ActivePresentation.Name) - 4)
   
   sld = 1
   slideCount = aPPT.ActivePresentation.Slides.Count
   
   For i = 1 To slideCount
       With aPPT.ActiveWindow
           .Activate
           .View.GotoSlide Index:=sld
           .Selection.SlideRange.Shapes.SelectAll
           
           .Selection.ShapeRange.Copy
           
       End With
   
       With Selection
           Application.Activate
           tempStr = presName & vbTab & "Slide #" & Str(sld) & " of" & Str(slideCount) & vbCrLf & vbCrLf
           .Font.Name = "Verdana"
           .TypeText (tempStr)
           .Font.Italic = True
           .Paste
           .EndKey Unit:=wdStory
           .InsertBreak Type:=wdPageBreak
           .Font.Italic = False
       End With
   
       sld = sld + 1
   Next i
   
   Application.ActiveDocument.SaveAs (presName & " (DOC version)")
   
   endTime = Time
  
   With Selection
       tempStr = "Summary" & vbCrLf & vbCrLf
       .Font.Bold = True
       .TypeText (tempStr)
       .Font.Bold = False
      
      
       tempStr = "Converted from "
       .TypeText (tempStr)
      
       .Font.Italic = True
       tempStr = aPPT.ActivePresentation.FullName
       .TypeText (tempStr)
      
       .Font.Italic = False
       tempStr = " on " & Date & vbCrLf & vbCrLf
      
       .TypeText (tempStr)
      
       tempStr = "Saved As "
       .TypeText (tempStr)
      
       .Font.Italic = True
       .Font.Bold = True
       tempStr = Application.ActiveDocument.FullName & vbCrLf & vbCrLf
       .TypeText (tempStr)
       .Font.Italic = False
       .Font.Bold = False
      
       tempStr = "Slides converted: " & slideCount & vbCrLf & vbCrLf
       .Font.Italic = True
       .TypeText (tempStr)
       .Font.Italic = False
      
       .Font.Italic = True
      
       tempStr = "Time Taken: " & DateDiff("s", startTime, endTime) & " seconds"
       .TypeText (tempStr)
      
       .Font.Italic = originalItalicStatus
       .Font.Bold = originalBoldStatus
      
   End With
   
   Application.ActiveDocument.Save
   Application.ActiveDocument.Activate
   
End Sub
有人给出一个这样的宏代码,但运行的时候出错