Reposition shape and text box on a slide

Question

I want to achieve when I select either a shape or a text box they will move to the same location (bottom align) on a slide. My shape and text box are different in height so for example with text boxes, some have one line and some have multiple lines. The text in the text box is aligned to Bottom in ppt.

I've tried using the code .top but it will move the text box that have two or more lines out of the slide area. Trying to fix if the selected shape or text box is in different height then it will stay in the lower-left corner from the bottom to go upward and stay on the slide. Below is the code I have so far. Thanks

 Sub PositionShape()
     Dim oshp As Shape
     On Error Resume Next

     Set oshp = ActiveWindow.Selection.ShapeRange(1)

     With oshp
         .LockAspectRatio = False
         .Left = 0.5 * 72
         .Top = 7.3 * 72
     End With

 End Sub

`.Top = (7.3 * 72) - .Height` or something along those lines — Tim Williams, Sep 19 '19 at 17:56
The .Top = (7.3 * 72) - .Height didn't work. Not sure what I'm missing. — pptbot, Sep 19 '19 at 18:10
I found this post similar to my problem, but didn't have a solution yet. https://stackoverflow.com/questions/53885841/fix-a-text-box-at-the-right-in-powerpoint-slide-from-excel-vba — pptbot, Sep 19 '19 at 19:15

score 5 · Accepted Answer · answered Sep 19 '19 at 20:39

This will move the bottom of the shape to the bottom of the slide:

Sub PositionShape()
  Dim oshp As Shape
  Dim SlideHeight&
  SlideHeight& = Application.ActivePresentation.PageSetup.SlideHeight
  Set oshp = ActiveWindow.Selection.ShapeRange(1)
  With oshp
    .Left = 0.5 * 72
    .Top = SlideHeight& - .Height
  End With
 End Sub

Reposition shape and text box on a slide

1 Answers1