' Exports visible PivotTables to PowerPoint ' Posted to SPSSX-L list on 2003/07/23 by Alex Vinogradov. Dim objPowerPoint As Object Dim objPresentation As Object Dim objOutput As ISpssOutputDoc Sub Main CreatePowerPoint CopySlides End Sub Sub CreatePowerPoint On Error Resume Next Set objPowerPoint = CreateObject("Powerpoint.Application") Set objPresentation = objPowerPoint.Presentations.Add objPowerPoint.Visible = True End Sub Sub CopySlides() Dim objItems As ISpssItems Dim objItem As ISpssItem Dim i,slide As Long On Error Resume Next If objSpssApp.Documents.OutputDocCount > 0 Then Set objOutput = objSpssApp.GetDesignatedOutputDoc Set objItems = objOutput.Items For i = 0 To objItems.Count - 1 Set objItem = objItems.GetItem(i) If (objItem.SPSSType = SPSSPivot) And objItem.Visible Then objPresentation.Slides.Add 1,12 End If Next slide = 0 For i = 0 To objItems.Count - 1 Set objItem = objItems.GetItem(i) If (objItem.SPSSType = SPSSPivot) And objItem.Visible Then slide = slide + 1 objPowerPoint.ActiveWindow.View.GotoSlide slide objItem.Deactivate Clipboard "" objOutput.ClearSelection objItem.Selected = True objOutput.Copy objPowerPoint.ActiveWindow.View.Paste End If Next End If End Sub