Macro to resize graphic by percentage and change location

  • Thread starter Thread starter Adam_needs_help
  • Start date Start date
A

Adam_needs_help

I have a macro that moves charts from excel into powerpoint. Now I need to
resize the pasted picture by a percentage and move it to another location on
the powerpoint slide. Here is the code I have:

'I am not using all of these, my code is modified from a few sources.
Dim objPPT As Object
Dim objPrs As Object
Dim objSld As Object
Dim shtTemp As Object
Dim chtTemp As ChartObject
Dim objShape As Shape
Dim objGShape As Shape
Dim intSlide As Integer
Dim blnCopy As Boolean

Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Open "C:...\test.ppt"
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
End If


'Select the RFQ Workbook
Workbooks("Total RFQs Per Buyer_Model By Aged 061209.xls").Activate
Sheets(PrgmName).Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture
' Paste chart
objPPT.ActiveWindow.View.GotoSlide Index:=5 'ChartNum
objPPT.ActiveWindow.View.Paste

Once pasted I want to reduce the size to 94% of the original shape and then
move it to a new location (i don' t have the coordinates of that but I want
it centered horizontally and will have to determine the vertical position
later).
 
I have a macro that moves charts from excel into powerpoint. Now I need to
resize the pasted picture by a percentage and move it to another location on
the powerpoint slide. Here is the code I have:

'I am not using all of these, my code is modified from a few sources.
Dim objPPT As Object
Dim objPrs As Object
Dim objSld As Object
Dim shtTemp As Object
Dim chtTemp As ChartObject
Dim objShape As Shape
Dim objGShape As Shape
Dim intSlide As Integer
Dim blnCopy As Boolean

Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Open "C:...\test.ppt"
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
End If


'Select the RFQ Workbook
Workbooks("Total RFQs Per Buyer_Model By Aged 061209.xls").Activate
Sheets(PrgmName).Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture
' Paste chart
objPPT.ActiveWindow.View.GotoSlide Index:=5 'ChartNum
objPPT.ActiveWindow.View.Paste

Once pasted I want to reduce the size to 94% of the original shape and then
move it to a new location (i don' t have the coordinates of that but I want
it centered horizontally and will have to determine the vertical position
later).
Click to expand...

Hmm. I don't work a lot in Normal view with copy and paste so I'm not sure,
but I have some ideas. The main thing you need is to get a pointer to the
shape you just pasted. When you first paste it in, it might still be
selected, which would mean that you might do something like:

With objPPT.ActiveWindow.Selection.Shape
.Width = .Width * .94
.Top = 122 'or wherever you want it
.Left = 416 'or wherever you want it
End With

If it is not selected right after a paste, it should be the last shape on
the slide, so you could try:

With objPPT.ActivePresentation.Slides(5)
.Shapes(.Shapes.Count).Width = .Shapes(.Shapes.Count).Width * .94
.Shapes(.Shapes.Count).Top = 122 'or wherever you want it
.Shapes(.Shapes.Count).Left = 416 'or wherever you want it
End With

This is just off the top of my head so it might not work, but it should give
you some ideas.

--David

--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland
 
The Second method worked, thanks so much!!!

David Marcovitz said:
Hmm. I don't work a lot in Normal view with copy and paste so I'm not sure,
but I have some ideas. The main thing you need is to get a pointer to the
shape you just pasted. When you first paste it in, it might still be
selected, which would mean that you might do something like:

With objPPT.ActiveWindow.Selection.Shape
.Width = .Width * .94
.Top = 122 'or wherever you want it
.Left = 416 'or wherever you want it
End With

If it is not selected right after a paste, it should be the last shape on
the slide, so you could try:

With objPPT.ActivePresentation.Slides(5)
.Shapes(.Shapes.Count).Width = .Shapes(.Shapes.Count).Width * .94
.Shapes(.Shapes.Count).Top = 122 'or wherever you want it
.Shapes(.Shapes.Count).Left = 416 'or wherever you want it
End With

This is just off the top of my head so it might not work, but it should give
you some ideas.

--David

--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland
Click to expand...
 
Back
Top