Hi Nicky,

Does this help?

The macro assumes that the Excel workbook has the same name as the P
file, except for the file extension.

The "Chart_Array" lists the names of the Excel worksheets, each o
which contains a chart. Each charts is then copied as a 'picture'.

Sub Import_Excel_Chart()

Dim Path_Name As String
Dim Last_Slide As Integer
Dim Slide_Index As Integer
Dim Chart_Array As Variant
Dim Chart_Value As Variant
Dim PP_App As PowerPoint.Application
Dim PP_Pres As PowerPoint.Presentation
Dim PP_Pres_Name As String
Dim PP_Slide As PowerPoint.Slide
Dim Excel_App As Excel.Application
Dim Excel_Book As Excel.Workbook
Dim Excel_Chart As Excel.Chart

On Error GoTo ERROR_HANDLER

Path_Name = CurDir & "\"
PP_Pres_Name = Left(ActivePresentation.Name
Len(ActivePresentation.Name) - 4)

Set PP_App = PowerPoint.Application
Set PP_Pres = PP_App.ActivePresentation

Last_Slide = PP_Pres.Slides.Count

If Last_Slide 0 Then
For Slide_Index = 1 To Last_Slide
ActiveWindow.Selection.SlideRange.Delete
Next Slide_Index
End If

Set Excel_App = Nothing
Set Excel_App = New Excel.Application

Excel_App.Application.Visible = False
Excel_App.Application.DisplayAlerts = False

Set Excel_Book = Excel_App.Workbooks.Open _
(Path_Name & PP_Pres_Name & ".xls")

Chart_Array = Array("OUTSTANDING_TRANSACTIONS", _
"OUTSTANDING_AMOUNTS", _
"AGED_RECORDS", _
"AGED_RECORDS_(with Total)", _
"AGED_RECORDS_(stacked)", _
"AGED_RECORDS_(stacked_100)", _
"AGED_RECORDS_(by Date)", _
"AGED_RECORDS_(by Date)_3D")

Slide_Index = 0

For Each Chart_Value In Chart_Array

Slide_Index = Slide_Index + 1

ActiveWindow.View.GotoSlid
Index:=ActivePresentation.Slides.Add _
(Index:=Slide_Index, Layout:=ppLayoutBlank).SlideIndex

Set PP_Slide = PP_Pres.Slides _
(PP_App.ActiveWindow.Selection.SlideRange.SlideInd ex)

COPY_CHART:
Excel_App.Charts(Chart_Value).CopyPicture Appearance:=xlScreen
Format:=xlPicture

PP_Slide.Shapes.Paste.Select

PP_App.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters
True
PP_App.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles
True

With ActiveWindow.Selection.ShapeRange
.Height = 414.88
.Width = 718.62
.Left = 0.75
.Top = 35
End With

ActiveWindow.Selection.Unselect

Next

ActiveWindow.View.GotoSlide (1)

GoTo ENDSUB

ERROR_HANDLER:
Msg = "Error occurred during copy process." & Chr(10)
Msg = Msg + " " & Chr(10)
Msg = Msg + "Re-run macro." & Chr(10)
Msg = Msg + " " & Chr(10)
Msg = Msg + "Process terminated." & Chr(10)
Msg = Msg + " "
Style = vbOKOnly
Response = MsgBox(Msg, Style, Title)

ENDSUB:
Excel_App.Application.DisplayAlerts = False
Set Excel_Book = Nothing
Set Excel_Chart = Nothing
Excel_App.Quit
Set Excel_App = Nothing

Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

Regards,
Mark_

--
Message posted from http://www.ExcelForum.com