Need to Copy Excel print_area page to PowerPoint with PrintTitleRows on each slide

[Hildegard$1]

I am new to the forum and medium skilled at vba. I copied this code from another post and it works great. What I am looking for is to get the PrintTitleRows at the top of each "picture" on the slides.

Here is what I have used for print but does not work for doing a picture copy to PowerPoint

With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$5"
end with

Here is the code which works to create the slides without the titles:

Sub Sheet_To_PowerPoint()
'works great, just needs heading on each page

Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim SlideCount As Long
Dim row As Long

Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True

For row = 6 To ActiveSheet.UsedRange.Rows.Count Step 30

ActiveSheet.Range("B" & row & ":s" & row + 30).CopyPicture Appearance:=xlScreen, Format:=xlPicture

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select

' PPSlide.Shapes.Paste.Select
PPSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 1
pp.ActiveWindow.Selection.ShapeRange.Left = 1
pp.ActiveWindow.Selection.ShapeRange.Width = 700



Next

pp.Activate

Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing

End Sub

[blane245]

try changing the Appearance to xlPrinter and setting the PrintRange to the enter sheet. See if that works better.