The problem is that once you've opened your excel application it becomes the
active object and so the code is trying to apply this line:-
With ActiveWindow.Selection.SlideRange
to Excel and not Powerpoint
If you rewrite your function so it includes the openppt subroutine and
change the line above to read:-
With pptapplication.ActiveWindow.Selection.SlideRange
I think it will work
Revised code is below:-
Public Function Test()
Dim xl As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim pptapplication As Object
Dim pptopen As Object
Dim pptpath As String
'Dim i%
Set xl = New Excel.Application
Set wb = xl.Workbooks.Open("c:\Test\SEQS.xls")
Set ws = wb.Worksheets(1)
pptpath = "C:\Test\THIS IS A TEST.ppt"
Set pptapplication = CreateObject("powerpoint.Application")
pptapplication.Visible = True
Set pptopen = pptapplication.Presentations.Open(Filename:=pptpath)
With pptapplication.ActiveWindow.Selection.SlideRange
For i = 1 To 3
.Shapes("Rectangle 2").TextFrame.TextRange.Text = ws.Cells(i,
1).Value
.Shapes("Rectangle 3").TextFrame.TextRange.Text = ws.Cells(i,
2).Value
ActiveWindow.Presentation.PrintOut 1, 1
Next i
End With
Set ws = Nothing
wb.Close SaveChanges:=False
Set wb = Nothing
xl.Quit
Set xl = Nothing
End Function
HTH
Andy W
"Koulla" wrote:
> Hi I want to copy/export/transfer charts from Excel to powerpoint. I have a
> workbook which contains 4 sheets with 2 charts in each sheet. I want each
> chart to appear to a separate slide in power point. I want to do that with
> VBA code. I already have some code put it doesnt works.
> The ppt file opens ok but in the function gives an error "Object doesnt
> support this property or method"
>
> Sub openppt()
>
> Dim pptapplication As Object
> Dim pptopen As Object
> Dim pptpath As String
>
> pptpath = "C:\Test\THIS IS A TEST.ppt"
>
> Set pptapplication = CreateObject("powerpoint.Application")
> pptapplication.Visible = True
> Set pptopen = pptapplication.Presentations.Open(Filename:=pptpath)
>
> End Sub
>
> Public Function Test()
> Dim xl As Excel.Application
> Dim wb As Workbook
> Dim ws As Worksheet
> 'Dim i%
>
> Set xl = New Excel.Application
> Set wb = xl.Workbooks.Open("C:\Test\SEQS.xls")
> Set ws = wb.Worksheets(1)
>
> With ActiveWindow.Selection.SlideRange ****HERE IT GIVES THE ERROR ****
> For i = 1 To 3
> .Shapes("Rectangle 2").TextFrame.TextRange.Text = ws.Cells(i,
> 1).Value
> .Shapes("Rectangle 3").TextFrame.TextRange.Text = ws.Cells(i,
> 2).Value
> ActiveWindow.Presentation.PrintOut 1, 1
> Next i
> End With
>
> Set ws = Nothing
> wb.Close SaveChanges:=False
> Set wb = Nothing
> xl.Quit
> Set xl = Nothing
>
> End Function
>
>
>
|