Excel to powerpoint
 

I would like to copy a range of data from excel and move it to
powerpoint (paste, paste special, excel worksheet object, whatever.) I
have a method that is working well in Powerpoint 2000, but the
formatting gets all screwed up in Powerpoint XP. I have a feeling it
is the "Paste" method that I use. Any advice? See code below.

Sub CreateNewPowerPointPresentation()
' to test this code, paste it into an Excel module
' add a reference to the PowerPoint-library
' create a new folder named C:\Foldername or edit the filnames in the
code
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i As Integer, strString As String
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new
presentation
' or open an existing presentation
' Set pptPres =
pptApp.Presentations.Open("C:\Foldername\Filename. ppt")

' apply a slide template
' pptPres.ApplyTemplate "C:\Program Files\Microsoft
Office\Templates\Presentation Designs\x.pot"
pptPres.ApplyTemplate "\\orl40050\shared\ISQUALPAM\Metrics\Program
Small q Scorecard\Automate\PRESTON1.pot"

'Title Slide

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With

With pptSlide
Shapes(1).TextFrame.TextRange.Text = "X " ' add a slide title
Shapes(2).Delete ' remove the text box
With .Shapes(.Shapes.Count)
Left = 50
Top = 150
Width = 600
'.Height = 250
End With
End With

' Slide 2

ThisWorkbook.Worksheets(1).Range("A2:D3").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
Shapes(2).Delete ' remove the text box
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 25
Top = 150
Width = 50
Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f3:f3").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 83
Top = 350
Width = 100
Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g3:g3").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 405
Top = 350
Width = 100
Height = 100
End With

End With

' Slide 3

ThisWorkbook.Worksheets(1).Range("A6:D7").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
Shapes(2).Delete ' remove the text box
Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 25
' .Top = 150
' .Width = 50
' .Height = 120
' End With

ThisWorkbook.Worksheets(1).Range("f7:f7").Copy ' copy an Excel
range
Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 83
' .Top = 350
' .Width = 100
' .Height = 100
' End With

ThisWorkbook.Worksheets(1).Range("g7:g7").Copy ' copy an Excel
range
Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 405
' .Top = 350
' .Width = 100
' .Height = 100
' End With

End With

' Slide 4

ThisWorkbook.Worksheets(1).Range("A13:D14").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
Shapes(2).Delete ' remove the text box
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 25
Top = 150
Width = 50
Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f14:f14").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 83
Top = 350
Width = 100
Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g14:g14").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 405
Top = 350
Width = 100
Height = 100
End With

End With

' Slide 5

ThisWorkbook.Worksheets(1).Range("A17:D18").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
Shapes(2).Delete ' remove the text box
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 25
Top = 150
Width = 50
Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f18:f18").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 83
Top = 350
Width = 100
Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g18:g18").Copy ' copy an Excel
range
Shapes.Paste
With .Shapes(.Shapes.Count)
Left = 405
Top = 350
Width = 100
Height = 100
End With

End With

Application.CutCopyMode = False ' end cut/copy from Excel
Set pptSlide = Nothing

On Error Resume Next ' ignore errors
Kill "......\MyNewPresentation.ppt"
With pptPres
SaveAs ".....\MyNewPresentation.ppt"
'.Close ' close the presentation
End With
On Error GoTo 0 ' resume normal error handling
Set pptPres = Nothing

pptApp.Visible = True ' display the application
'pptApp.Quit ' or close the PowerPoint application
Set pptApp = Nothing
End Sub


---
Message posted from http://www.ExcelForum.com/

Excel to powerpoint
 

Todd -

What I've noticed in PowerPoint XP, is that it tries to guess where I
want the chart to appear when I paste it into a slide. I think this
happens despite picking a blank slide layout, but I need to investigate
further to be sure. The pasted object (a chart, or a graphic from
another program) will be shrunk or distorted to fit into one of the
layouts. I've had it change the assumed layout from image plus text to
two images plus text when I pasted a second chart.

Hmm, so I just started testing this with my favorite Excel 97 - PPT 97
chart copy - paste routine. The charts do not seem to interact with the
template the way manual pasting does (as I described above). But in the
past, when I entered a percentage of the original size to scale the
chart to, I had to divide that by 100 and use it in the scale method.
Apparently now the number is internally divided by 100, so all the
charts come into PowerPoint at 1% of their original size. Why would such
an obvious thing be changed??

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______

toddmbright < wrote:

I would like to copy a range of data from excel and move it to
powerpoint (paste, paste special, excel worksheet object, whatever.) I
have a method that is working well in Powerpoint 2000, but the
formatting gets all screwed up in Powerpoint XP. I have a feeling it
is the "Paste" method that I use. Any advice? See code below.

Sub CreateNewPowerPointPresentation()
' to test this code, paste it into an Excel module
' add a reference to the PowerPoint-library
' create a new folder named C:\Foldername or edit the filnames in the
code
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i As Integer, strString As String
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new
presentation
' or open an existing presentation
' Set pptPres =
pptApp.Presentations.Open("C:\Foldername\Filename. ppt")

' apply a slide template
' pptPres.ApplyTemplate "C:\Program Files\Microsoft
Office\Templates\Presentation Designs\x.pot"
pptPres.ApplyTemplate "\\orl40050\shared\ISQUALPAM\Metrics\Program
Small q Scorecard\Automate\PRESTON1.pot"

'Title Slide

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With

With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "X " ' add a slide title
.Shapes(2).Delete ' remove the text box
With .Shapes(.Shapes.Count)
.Left = 50
.Top = 150
.Width = 600
'.Height = 250
End With
End With

' Slide 2

ThisWorkbook.Worksheets(1).Range("A2:D3").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
.Shapes(2).Delete ' remove the text box
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 25
.Top = 150
.Width = 50
.Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f3:f3").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 83
.Top = 350
.Width = 100
.Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g3:g3").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 405
.Top = 350
.Width = 100
.Height = 100
End With

End With

' Slide 3

ThisWorkbook.Worksheets(1).Range("A6:D7").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
.Shapes(2).Delete ' remove the text box
.Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 25
' .Top = 150
' .Width = 50
' .Height = 120
' End With

ThisWorkbook.Worksheets(1).Range("f7:f7").Copy ' copy an Excel
range
.Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 83
' .Top = 350
' .Width = 100
' .Height = 100
' End With

ThisWorkbook.Worksheets(1).Range("g7:g7").Copy ' copy an Excel
range
.Shapes.Paste
' With .Shapes(.Shapes.Count)
' .Left = 405
' .Top = 350
' .Width = 100
' .Height = 100
' End With

End With

' Slide 4

ThisWorkbook.Worksheets(1).Range("A13:D14").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
.Shapes(2).Delete ' remove the text box
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 25
.Top = 150
.Width = 50
.Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f14:f14").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 83
.Top = 350
.Width = 100
.Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g14:g14").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 405
.Top = 350
.Width = 100
.Height = 100
End With

End With

' Slide 5

ThisWorkbook.Worksheets(1).Range("A17:D18").Copy ' copy an Excel
range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "X" ' add a slide title
.Shapes(2).Delete ' remove the text box
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 25
.Top = 150
.Width = 50
.Height = 120
End With

ThisWorkbook.Worksheets(1).Range("f18:f18").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 83
.Top = 350
.Width = 100
.Height = 100
End With

ThisWorkbook.Worksheets(1).Range("g18:g18").Copy ' copy an Excel
range
.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 405
.Top = 350
.Width = 100
.Height = 100
End With

End With

Application.CutCopyMode = False ' end cut/copy from Excel
Set pptSlide = Nothing

On Error Resume Next ' ignore errors
Kill "......\MyNewPresentation.ppt"
With pptPres
.SaveAs ".....\MyNewPresentation.ppt"
'.Close ' close the presentation
End With
On Error GoTo 0 ' resume normal error handling
Set pptPres = Nothing

pptApp.Visible = True ' display the application
'pptApp.Quit ' or close the PowerPoint application
Set pptApp = Nothing
End Sub


---
Message posted from http://www.ExcelForum.com/