How to copy multiple objects from Excel to PowerPoint

[Rob Flott]

I have Excel 2007 and work in Windows Vista.

I am trying to write code to copy 2 different objects (1 chart, 1
Named Range) from a page in an Excel workbook and paste them onto a
slide in PowerPoint. The attached code works fine for one object, but
I am lost trying to copy more than one object. I apprecaite any
direction.

TIA

Here's the code in the Excel WB:

Sub XlChart_To_PPT()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation

'Get existing instance of PP if it's open; otherwise create a new one
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application") '<added comma
If Err Then
Set PPApp = New PowerPoint.Application
PPApp.Visible = msoTrue '<made application visible
Set PPPres = PPApp.Presentations.Open("C:\Data\Frozen Scale
Reports\Frz.pptm")
Else
Set PPPres = PPApp.Presentations("Frz.pptm")
PPApp.Visible = msoTrue '<made application visible
End If

On Error GoTo 0

'************Copy Excel Chart
Sheets("Copy1").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Copy

'******Runs macro in PPT that copies data from excel and pastes
onto PPT slides
PPApp.Run (PPPres.Name & "!Paste1")

'***********************************
Beep

Sheets("Copy1").Select
Range("A1").Select
End Sub

Here's the corresponding code in PowerPoint:

Sub AddNewChart()
ActivePresentation.Slides.Add(Index:=3,
Layout:=ppLayoutText).Select
ActiveWindow.Selection.SlideRange.Layout = ppLayoutBlank
End Sub

Sub Paste1()
'****Copies the Trip DemoGraph and pastes into a new PPT Slide
Dim ActP As Presentation
Dim NewSlide As Slide

Set ActP = ActivePresentation
Application.DisplayAlerts = ppAlertsNone

ActiveWindow.ViewType = ppViewSlideSorter
Application.DisplayAlerts = ppAlertsNone

Set NewSlide = ActP.Slides.Add(ActP.Slides.Count + 1,
ppLayoutBlank)
NewSlide.Select

Application.DisplayAlerts = ppAlertsNone
ActiveWindow.ViewType = ppViewSlide
ActiveWindow.View.PasteSpecial (ppPasteEnhancedMetafile)

With ActiveWindow.Selection.ShapeRange
.IncrementLeft 40
.IncrementTop 10
End With

ActiveWindow.Selection.Unselect
End Sub