How to update Office 2003 code to compatible with Offfice 2007

[yurble_vn]

Dear all,

I have used this code (the following) to automatically copy all chart in selected worksheet in active excel and paste as link to active powerpoint. It works well with MS.excel 2003 and powerpoint 2003.

But, when trying to run this code in MS. Excel 2007, it returns error feedbacks. ( error code is marked in red and underline)


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.IncrementTop -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
After searching internet, I have changed to the following code (the bottommost) (Changed code is marked in Blue and Blod). And it eliminates the error from powerpoint, but there is still an error in the "paste link" command:


.Shapes.PasteSpecial(Link:=True).Select

Is there any replacement code for this command to make it being compatible with MS. Excel 2007? Please help, I'm not master in VBA. just can copy, paste and make some small modifying

Thanks


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

Dim PPApp As Object ' As PowerPoint.Application
Dim PPPres As Object ' As PowerPoint.Presentation
Dim PPSlide As Object ' As PowerPoint.Slide
Dim Presentation FileName 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 = 1 ' 1 = 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.IncrementTop -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