Copy each excel worksheets and paste in each indivual slides

[JonPeltier]

Shazam's code is rather inefficient. It loops among the sheets in the workbook four times instead of the one time which would be required, it dumps a picture of each worksheet's used range into the worksheet, then copies all pictures in each worksheet, not just the picture of the used range, into a slide. Also, he sets a reference to the PowerPoint object library, but late binds most of the PowerPoint object variables (i.e., declares them As Object).

A more efficient way is following this untested code:
[VBA] ' instantiate powerpoint
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPre = pptApp.Presentations.Add

' loop the sheets
For Each objSheet in ActiveWorkbook.Worksheets
objSheet.activate
If TypeName(Selection) = "Range" Then
' copy the selection, if it's a range
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Create new slide for the data
Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

' paste the copied picture
pptSld.Shapes.Paste

End If
Next
[/VBA]

[Darthvader]

Hi Jon

Can this code be modified to copy the contents of each sheet? (assume each sheet has contents fitting exactly one page). Thanks

Shazam's code is rather inefficient. It loops among the sheets in the workbook four times instead of the one time which would be required, it dumps a picture of each worksheet's used range into the worksheet, then copies all pictures in each worksheet, not just the picture of the used range, into a slide. Also, he sets a reference to the PowerPoint object library, but late binds most of the PowerPoint object variables (i.e., declares them As Object).

A more efficient way is following this untested code:
[vba] ' instantiate powerpoint
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPre = pptApp.Presentations.Add

' loop the sheets
For Each objSheet in ActiveWorkbook.Worksheets
objSheet.activate
If TypeName(Selection) = "Range" Then
' copy the selection, if it's a range
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Create new slide for the data
Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

' paste the copied picture
pptSld.Shapes.Paste

End If
Next
[/vba]

[JonPeltier]

That's pretty much what it does. What you could do is modify the range selection bit to use the print area of each sheet:

[VBA]For Each objSheet In ActiveWorkbook.Worksheets
objSheet.Activate

ObjSheet.Range("Print_Area").CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Create new slide for the data
Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

' paste the copied picture
pptSld.Shapes.Paste

Next[/VBA]

or simply copy the used range:

[VBA] ObjSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
[/VBA]

[Darthvader]

Thanks

How would you modify this code if you were a) doing the same for a word document to powerpoint (1 page per slide) and b) doing the same for an existing powerpoint doc to a new pp doc (slide for slide)?

Kind Regards

That's pretty much what it does. What you could do is modify the range selection bit to use the print area of each sheet:

[VBA]For Each objSheet In ActiveWorkbook.Worksheets
objSheet.Activate

ObjSheet.Range("Print_Area").CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Create new slide for the data
Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

' paste the copied picture
pptSld.Shapes.Paste

Next[/VBA]

or simply copy the used range:

[VBA] ObjSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
[/VBA]