Hi all,

I have run this code (the following) in Excel 2003, it works well. Its
to copy all chart in selected WorkSheet to active powerpoint.

But when put this code to Excel 2007, it does not work anymore. Can
anyone help me to modify it to be compatible with Excel 2007. I really
sorry to ask such question, but as you know, I dont know any about
programming, just copy,paste, and do some small modifying.

Really need your help.

Thank in advance


Sub ChartsAndTitlesToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String
Dim wks As Worksheet

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For Each wks In ActiveWorkbook.Windows(1).SelectedSheets
' change ActiveSheet to wks
For iCht = 1 To wks.ChartObjects.Count
With wks.ChartObjects(iCht).Chart

' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If
' copy chart as a picture
.ChartArea.Copy
End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.PasteSpecial(Link:=True).Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignLefts,
True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignBottoms,
True
PPApp.ActiveWindow.Selection.ShapeRange.IncrementT op -25#
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next
Next

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub