PDA

View Full Version : copy paste looping between Ppt and Excel



s.schwantes
09-02-2008, 01:03 PM
Hi All,

I think this is primariliy a ppt issue, but since it includes working w/ Excel, I'm also posting it in this forum as well...

I've got a working program for grabbing tables (as named ranges) and charts from Excel and then pasting them into text box shapes in powerpoint. Works fine, but I will eventually need to blow this out from 2 slides to a full deck with ~ 30 plus slides. Rather than keep incrementing all the code for each iteration, I'm wondering how to set this up as a loop using either simple counters or maybe a "For Each" worksheet or a combination of nested for next statements. I'm thinking the toggling between Ppt and Excel given the current structure of this program might cause problems. The simple part is I've got one table and one chart on each tab in my workbook. So, that might help. Also, each table will be a named range, e.g., Table1, Table2, Table3. And, each chart will just be ChartObjects1, on the current worksheet. Any way ... here's the code as it is now:

Thanks in advance for any brilliant suggestions!

Steve Schwantes

Also, btw .. most of the credit for this code goes to Shyam Pillai.



'Paste Excel TABLE (as a named range) as a picture in PowerPoint (Paste Special)

Sub XlChartPasteSpecial()
Dim xlApp As Object
Dim xlWrkBook As Object
Dim lCurrSlide As Long
Set xlApp = CreateObject("Excel.Application")

'Open the Excel workbook

Set xlWrkBook = xlApp.Workbooks.Open("C:\BOOK1.XLS")

'GET / COPY Excel Table1

Dim PasteRange As Boolean
Dim RangePasteType As String
Dim RangeName As String

PasteRange = True
RangeName = "Table1"
RangePasteType = "HTML"
RangeLink = True

'Copy Table

xlWrkBook.Worksheets(1).Range("Table1").CopyPicture

'Switch back to PPT

ActiveWindow.View.GotoSlide Index:=1
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 6").Select
ActiveWindow.View.Paste

'GET / COPY Excel Chart1

Set xlApp = CreateObject("Excel.Application")
'Open the Excel workbook
Set xlWrkBook = xlApp.Workbooks.Open("C:\BOOK1.XLS")

'Copy Chart

xlWrkBook.Worksheets(1).ChartObjects(1).CopyPicture

'Switch back to PPT

ActiveWindow.View.GotoSlide Index:=1
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 4").Select
ActiveWindow.View.Paste

'GET NEXT (SLIDE 2)

'GET / COPY Excel Table2

PasteRange = True
RangeName = "Table2"
RangePasteType = "HTML"
RangeLink = True

'Copy Table

xlWrkBook.Worksheets(2).Range("Table2").CopyPicture

'Switch back to PPT

ActiveWindow.View.GotoSlide Index:=2
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 6").Select
ActiveWindow.View.Paste

'GET / COPY Excel Chart2

Set xlApp = CreateObject("Excel.Application")

'Open the Excel workbook

Set xlWrkBook = xlApp.Workbooks.Open("C:\BOOK1.XLS")

'Copy Chart

xlWrkBook.Worksheets(2).ChartObjects(1).CopyPicture

'Switch back to PPT

ActiveWindow.View.GotoSlide Index:=2
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 4").Select
ActiveWindow.View.Paste

'Close Excel without saving


xlWrkBook.Close (False)
xlApp.Quit
Set xlApp = Nothing
Set xlWrkBook = Nothing

End Sub