Excel Table in Powerpoint

[David Offenberg]

In am trying to write an Excel table onto a Powerpoint slide. I have
not had any luck so far. I was able to write an Excel graph to the
Powerpoint presentation though, using the following code:

With PPPres.Slides(4)
Worksheets("charts").ChartObjects("Chart 1").Activate
ActiveChart.CopyPicture xlScreen, xlPicture, xlScreen
.Shapes.Paste
End With

Any ideas how I could do the same thing with a table?

[Stephen M. Rasey]

I use the following manual process to paste the worksheet display into a PPT
slide:
Copy Worksheet Range
Switch to ppt
Paste Special, Paste as Metafile
Position and Resize to fit.

In VBA code to make this work, at least in XL97, I have to use a SendKeys
process to do the Paste Special part.

Of course it is not a live worksheet, but since you are using Copy as
picture for the graph, a Metafile for the worksheet would seem to be
appropriate.

However, now that I check the vba editor, I see that a range object also has
the CopyPicture method so your Code should work with only minor
modification:

With PPPres.Slides(i)
Worksheets("Sheet1").Range("Display1").select ' Where
Display 1 is the name of a single block of cells to copy.
Selection.CopyPicture xlScreen, xlPicture
.Shapes.Paste
End With

This is untested, but I think it will work.

Stephen Rasey
Houston

David Offenberg wrote in message <3965E352...@zdnetonebox.com>...

[David Offenberg]

In order to do the steps you suggested below, I am using the following code:

Worksheets("Worksheet").Range("Range").Select
Selection.Copy
AppActivate (PPApp)
SendKeys "%E{DOWN 5}A{DOWN 2}~", True

The sendkeys string is exactly what I would push to do a metafile paste special.

I am not getting any results from this sendkeys method. It might as well not
even be in my code. Any suggestions?

(Your other suggestion for a paste will not work in this case because I need to
keep the file as small as possible.)

Thanks for your help!

-David

[David Offenberg]

[Stephen M. Rasey]

I just tried this on my Office 97 setup here.
NOTE: I believe that Office 2000 has a slightly different Paste As list box,
so it may need to be altered.

Sub PasteSpecialMetafileXLChart()
'Paste Special, Paste, Picture (Metafile), OK
'assumes that PPT is the active presentation and you are in Slide View
mode.
'Also assumes that an Excel Chart object or Worksheet Range is on the
clipboard.
'consider this experimental - SendKeys is always a fragile process.
'Stephen M. Rasey 990308, 000711 - Texaco Exploration
SendKeys "%esp{tab}pp{tab}~", True
SendKeys "{tab}", True
SendKeys "+{tab}", True
End Sub

-----------------
The following is a TESTED subroutine that copies a range of cells AS A
PICTURE.
In my tests, the PPT file was HALF the size of one with Paste Special as
Metafile. I don't know why this should be so and it might be a minor
mistake on my part. Nevertheless, CopyPicture seems to be a space
efficient procedure.

Sub copyXLRange1(wb As Workbook, strSht As String, strRngName As String)
'Copy as Picture, an XL Sheets(strSht).Range(strRngName)
'Create A new PPT slide (Title Only)
'Paste and resize the picture of the worksheet Range.
'Inputs:
'wb be an Excel Workbook Object.
'strSht = String of the Worksheet Name
'strRngName = string of either the Name of a range on the worksheet,
or
' string of cell references on the sheet.
'there is no error handling in this subroutine.

'Stephen M. Rasey 000711 - Texaco Exploration

Dim sht1 As Worksheet
Set sht1 = wb.Worksheets(strSht)
sht1.Range(strRngName).CopyPicture
NewSlideTitleOnly
ActiveWindow.View.Paste
PositionPortChart625
End Sub

Sub NewSlideTitleOnly()
'Insert a new slide after the current slide, Title only.
'same as Cntl M hot key
'Stephen Rasey 000319 - Texaco Exploration
Dim lSI As Long 'SlideIndex
ActiveWindow.ViewType = ppViewSlide
lSI = ActiveWindow.View.Slide.SlideNumber
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=lSI + 1,
Layout:=ppLayoutTitleOnly).SlideIndex
End Sub

Sub PositionPortChart625()
'Stephen Rasey 000319 - Texaco Exploration
With ActiveWindow.Selection.ShapeRange
.Height = 449.88
.Width = 593.12
End With
With ActiveWindow.Selection.ShapeRange
.IncrementLeft 66#
.IncrementTop 78#
End With
End Sub

Good Luck
Stephen Rasey.

[Stephen M. Rasey]

Errata: The VBA code in the parent note is PowerPoint VBA that uses Office
Automation to access the Excel Object Model

Stephen Rasey
Houston

[Peltier]

I noticed nobody's really using VBA, just SendKeys. I'm not good at it,
but I know it can be done. I had snagged a piece of code a month ago
off this group from someone named Kye Andersen, which he'd posted to
show someone how to paste a chart from Excel as a picture into
PowerPoint. I tweaked it a little to make it work (the first procedure
below), then I adjusted a few things so it would paste a spreadsheet
range as a picture (second procedure). Worked pretty well.

It's up to you to make it use the open instance of PowerPoint, and to
put it into an existing presentation, and to format it exactly right.
I'd try it but all my notes are at work (and I'm home Friday night
typing to you all, how sad!). But I at least had to do this, because
SendKeys is such a lame way to automate things in VBA.

First you need to set a reference (from the VBE Tools menu) to the
PowerPoint Object Library, then just paste and click.

Enjoy!
- Jon
_______

' start code ==================================================

Sub ChartToPresentation()
' First you must set VBE reference to Microsoft PowerPoint 8.0 Object
Library

Dim ChartName As Variant
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim CurrentTitle As Variant
Dim SlideCount As Long

Set PPApp = CreateObject("Powerpoint.Application.8")
Set PPPres = PPApp.Presentations.Add

CurrentTitle = "XlChartToPresentation" 'place a title name here
PresentationFileName = PPApp.ActivePresentation.Path
PresentationFileName = PresentationFileName & CurrentTitle & ".ppt"

ChartName = "Chart1" 'chart sheet name here
Charts(ChartName).Activate
ActiveChart.CopyPicture xlScreen, xlBitmap, xlScreen

SlideCount = PPPres.Slides.Count

Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With
SlideCount = SlideCount + 1

With PPPres
.SaveAs PresentationFileName
.Close
End With

PPApp.Quit

Set PPApp = Nothing
Set PPPres = Nothing

End Sub
' =============================================================
Sub RangeToPresentation()
' First you must set VBE reference to Microsoft PowerPoint 8.0 Object
Library

Dim SheetName As Variant
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim CurrentTitle As Variant
Dim SlideCount As Long

Set PPApp = CreateObject("Powerpoint.Application.8")
Set PPPres = PPApp.Presentations.Add

CurrentTitle = "XlRangeToPpt" 'place a title name here
PresentationFileName = PPApp.ActivePresentation.Path
PresentationFileName = PresentationFileName & CurrentTitle & ".ppt"

SheetName = "Sheet1" 'chart sheet name here
Sheets(SheetName).Range("MyRange").CopyPicture xlScreen, xlPicture

SlideCount = PPPres.Slides.Count

Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With
SlideCount = SlideCount + 1

With PPPres
.SaveAs PresentationFileName
.Close
End With

PPApp.Quit

Set PPApp = Nothing
Set PPPres = Nothing

End Sub

' end code ====================================================