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/