copy paste looping between Ppt and Excel

[s.schwantes]

Hi All,

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

[s.schwantes]

Update:

I've built this out now so that it now pulls in 28 tables and 28 charts from my Excel file and pastes them into 28 slides.

That's working fine.

The weird part is the Excel application is not open, but if I try to open the workbook from my C Drive I get a message that it is locked for editing. If I open my task manager, I don't see an Excel application running, but if I click on the Processes tab and sort on image name, I see 28 separate Excel processes still running.

What's going on? What's wrong with this program? Any ideas????

Thanks!!

[s.schwantes]

btw ... I'm running Office 2003 SP3, and XP SP2.

[geospatial]

I dont have anything that will help you, but I think you have helped me out a lot. My question is how can I use the code you have posted but without having to open Excel? By this I mean I have a button that is on the first sheet of my workbook. I want to click the button and have it run the process you have posted.

Also were can i change the code to look at the worksheet named "Charts".


Thanks

[s.schwantes]

Hey geospatial -

interesting handle ... i was a geography major myself ...

any way, my code was borrowed and tweaked to allow the copy paste of tables and charts in an excel work book into a power point deck.

Excel never needs to be "opened" in this case. the code calls for windows to open and close excel w/o saving any changes.

There are other snippets of code available to do the opposite, i.e., to have Excel call ppt to paste objects from excel to ppt.

there are several really good sites out there that MVPs have setup that post these snippets

If you can give me more detail, I might be able to help, or I can pass on the links ...

Steve S.

[geospatial]

I never have gotten to take any college courses in the geospatial world. My unit was deployed I got 3 days training and sent to Iraq and been doing it as a civilian since I got back.

Right now I have an excel workbook that has seven worksheets. One has all my data. Two sheets have filtered data. One sheet has pivot Tables, one has a stats sheet that pulls data from all the pivot tables into a nicer looking table, there is one that has charts, and my main sheet is just a graphic with buttons that link and filter out information but also has an update data button. Every day I put new information into a worksheet and hit the update data button. This reruns filters and puts the data in its corresponding sheet. Then it refreshes the pivot tables and charts. After that I need to have all the charts be exported to a ppt presentation that I have already named Charts.pptx

All my charts are in a worksheet called "Charts". There are 20 Charts and I have named them in Chart 1, Chart 2... format. I just need to be able to export the charts into their own slide in PPT and then have it save and close.

Dont know if this is possible or not. Im sure it is, but I have no idea how to do it.

Thanks for any help I can get on this,

Jason

[s.schwantes]

here is some borrowed code that you can try

let me know how it turns out

btw ... what kind of civilian work are you doing ... GIS / GPS ?

it's all cool stuff in my book!




Sub Copy_Paste_to_PowerPoint()

'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide


Dim SheetName As String
Dim TestRange As Range
Dim TestSheet As Worksheet
Dim TestChart As ChartObject

Dim PasteChart As Boolean
Dim PasteChartLink As Boolean
Dim ChartNumber As Long

Dim PasteRange As Boolean
Dim RangePasteType As String
Dim RangeName As String
Dim AddSlidesToEnd As Boolean
Dim MyRange As Range
'Parameters

'SheetName - name of sheet in Excel that contains the range or chart to copy

'PasteChart -If True then routine will copy and paste a chart
'PasteChartLink -If True then Routine will paste chart with Link; if = False then paste chart no link
'ChartNumber -Chart Object Number
'
'PasteRange - If True then Routine will copy and Paste a range
'RangePasteType - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
'RangeName - Address or name of range to copy; "B3:G9" "MyRange"
'AddSlidesToEnd - If True then appednd slides to end of presentation and paste. If False then paste on current slide.
For x = 1 To ActiveWorkbook.Sheets.Count
'use active sheet. This can be a direct sheet name
Sheets(x).Select
SheetName = ActiveSheet.Name
ActiveSheet.Names.Add Name:="MyRange", _
RefersTo:="=$A$1:$A$1", Visible:=True



'Setting PasteRange to True means that Chart Option will not be used
PasteRange = True
Set MyRange = Range("A1:A1")
RangeName = "MyRange"
RangePasteType = "HTML"
RangeLink = True

PasteChart = True
PasteChartLink = True
ChartNumber = 1

AddSlidesToEnd = True


'Error testing
On Error Resume Next
Set TestSheet = Sheets(SheetName)
Set TestRange = Sheets(SheetName).Range(RangeName)
Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
On Error GoTo 0

If TestSheet Is Nothing Then
MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical
Exit Sub
End If

If PasteRange And TestRange Is Nothing Then
MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical
Exit Sub
End If

If PasteRange = False And PasteChart And TestChart Is Nothing Then
MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical
Exit Sub
End If


'Look for existing instance
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Create new instance if no instance exists
If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
'Add a presentation if none exists
If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add

'Make the instance visible
ppApp.Visible = True

'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
If ppApp.ActivePresentation.Slides.Count = 0 Then
Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Else
If AddSlidesToEnd Then
'Appends slides to end of presentation and makes last slide active
ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
Else
'Sets current slide to active slide
Set ppSlide = ppApp.ActiveWindow.View.Slide
End If
End If

'Options for Copy & Paste Ranges and Charts
If PasteRange = True Then
'Options for Copy & Paste Ranges
If RangePasteType = "Picture" Then
'Paste Range as Picture
Worksheets(SheetName).Range(RangeName).Copy
ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
Else
'Paste Range as HTML
Worksheets(SheetName).Range(RangeName).Copy
ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
End If
Else
'Options for Copy and Paste Charts
Worksheets(SheetName).Activate
ActiveSheet.ChartObjects(ChartNumber).Select
If PasteChartLink = True Then
'Copy & Paste Chart Linked
ActiveChart.ChartArea.Copy
ppSlide.Shapes.PasteSpecial(link:=True).Select
Else
'Copy & Paste Chart Not Linked
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ppSlide.Shapes.Paste.Select
End If
End If

'Center pasted object in the slide
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

AppActivate ("Microsoft PowerPoint")
Set ppSlide = Nothing
Set ppApp = Nothing
ActiveSheet.Names("MyRange").Delete
Next
End Sub

[s.schwantes]

One thing you need to do is open the Visual Basic editor from Excel (Tools-Macro-VB Editor) then click Tools-References and find the Microsoft Power Point object library and check the box.

This allows Excel's vba to access Power Point's objects and their methods and properties - - which are different than Excel's object names and properties and even methods.

Think of it as a tackle box containing the right lures and hooks to catch a specific kind of fish.


A for next loop has been added, as well as some code to create (and delete) a named range called MyRange as it advances to each new sheet. I think this code is pretty straightforward and it contains stuff for charts too.