¿Cómo copio todos elementos de powerpoint a word?

Option Explicit

Private Sub CopiarWord()
Dim n As Integer, WDoc As Object

    Set WDoc = CreateObject("Word.Application")
    WDoc.Visible = True
    WDoc.documents.Add
    

    For n = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(n).Select             ' Activate present slide
        ActiveWindow.Selection.SlideRange.Shapes.SelectAll
        ActiveWindow.Selection.Copy                     ' Copy to clipboard
        
        WDoc.Selection.endkey Unit:=6  'wdStory
        If n > 1 Then WDoc.Selection.InsertBreak Type:=7         'wdPageBreak
        WDoc.Selection.Paste
    
    Next n
    
    WDoc.activedocument.saveas2 FileName:="C:\Temp\DocumentoDiapo1.docx"
    WDoc.Quit
    Set WDoc = Nothing

End Sub