ohmetw
asked on
VBA to paste range cells into a ppt (all set) and fit to exact width of page (need help)
I have a vba script created to change pulldown selections in an xls sheet, that drive data in a range of cells. I need to cycle thru around 100 options and copy paste the results of the range of cells onto a new ppt page, for a report out.
I have the vb. script working great, just need help in one area, I need the range of cells being copied to paste into the ppt and stretch/shrink to match the exact width of the ppt page. The size of the paste is very close to the width (just a little larger) so I'm not too concerned about maintaining aspect ratio (that's a nice to have) but definitely need to shrink each to fit. I've attached portion of my code below so you can see how it is working
'Set osl = PowerPointApp.ActivePresen tation.Sli des.Add ActivePresentation.Slides. Count + 1, ppLayoutTitleOnly
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add( 1, ppLayoutTitleOnly)
mySlide.Shapes.Title.TextF rame.TextR ange.Text = ppt_pg_ttl
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecia l DataType:=ppPasteEnhancedM etafile
Set myShapeRange = mySlide.Shapes(mySlide.Sha pes.Count)
'Set position:
myShapeRange.Left = 0
myShapeRange.Top = 100
'***HERE IS WHERE I TRIED TO SCALE THE IMAGE
'***.....I WOULD LIKE TO MAKE IT A PERFECT FIT INSTEAD OF A GUESSTIMATE
'myShapeRange.ScaleWidth(0 .9)
I have the vb. script working great, just need help in one area, I need the range of cells being copied to paste into the ppt and stretch/shrink to match the exact width of the ppt page. The size of the paste is very close to the width (just a little larger) so I'm not too concerned about maintaining aspect ratio (that's a nice to have) but definitely need to shrink each to fit. I've attached portion of my code below so you can see how it is working
'Set osl = PowerPointApp.ActivePresen
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(
mySlide.Shapes.Title.TextF
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecia
Set myShapeRange = mySlide.Shapes(mySlide.Sha
'Set position:
myShapeRange.Left = 0
myShapeRange.Top = 100
'***HERE IS WHERE I TRIED TO SCALE THE IMAGE
'***.....I WOULD LIKE TO MAKE IT A PERFECT FIT INSTEAD OF A GUESSTIMATE
'myShapeRange.ScaleWidth(0
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.