Link to home
Start Free TrialLog in
Avatar of tchristie33
tchristie33

asked on

auto size and position powerpoint image using excel vba

I have everything working to paste my picture from excel into powerpoint, but I want to maximize the size (keeping the dimensions in proportion) and position it centered near the top of the slide (not the very top since my title is at the very top). How do I complete my code to do this? Thanks
Set wbMast = ThisWorkbook
Set D = wbMast.Sheets("Values")
Workbooks.Open D.[A43].Text, never
Set wbPT = ActiveWorkbook
Set pptApp = CreateObject("powerpoint.application")
pptApp.Visible = True
pptApp.presentations.Open D.[A44].Text, never
Set wbPP = pptApp.presentations(1)
For Each Item In D.Range("C2:C" & D.[C42].End(xlUp).Row)
    wbPT.Sheets(Item.Text).Activate
    Range(Item.Offset(, 1)).CopyPicture Appearance:=xlScreen, Format:=xlPicture
    wbPP.slides(3).Select
    wbPP.slides(3).Shapes.Paste.Select
'below does not work
    wbPP.Selection.ShapeRange.Align msoAlignCenters, True
    wbPP.Selection.ShapeRange.ScaleHeight 1, msoTrue
    wbPP.Selection.ShapeRange.ScaleWidth 1, msoTrue
Next Item

Open in new window

Avatar of John Wilson
John Wilson
Flag of United Kingdom of Great Britain and Northern Ireland image

Have you thought about having a pre placed rectangle on the slides and fitting the height or width of the pasted image to it? (Then delete the rectangle)
Avatar of tchristie33
tchristie33

ASKER

not sure how that would work, but I am not thinking it would do what I want. How do I even begin to start centering or size my picture without an error though?
I think it would!
Assuming the rectangle is placed at the position of the largest possible picture.

Work out whether the aspect ratio is wider than the picture (or not)
Based on this set either the width or height to equal that of the rectangle
Adjust the top or left based on the top/height or left/width of the rectangle so that that it is vertically or horizontally centred in the rectangle.

eg the left of the pasted shape might be the left of the rectangle plus half the diffence in width

Sounds complex but it works every time.
how would I do that in excel vba....this whole thing needs to be automated. can you suggest some code for this?
ASKER CERTIFIED SOLUTION
Avatar of tchristie33
tchristie33

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial