Need to set shape position in PowerPoint to the same value across all slides

1
votes

I have dozens of PowerPoint shows that contain dozens of slides each. They are very basic in that there is only one shape on each slide and there is no animation being used on the shape or between slides. The issue is that the person who created them didn't really pay attention to the vertical position of the shapes from slide to slide so it's very noticeable when going from one slide to the next.

I would like to be able to quickly set the vertical position to the same value for each shape on each slide. The horizontal position is fine. I've been doing them manually but there are a lot of slides and slide shows to go through and I'd rather not have to do this as it is very time consuming.

I've done some searching here on this site as well as on Google but haven't found anything yet. If it requires VBA code, that's fine too.

I am using PowerPoint 2010.

2
vbapowerpointpowerpoint-2010

2 Answers

1
votes

As a starting point (total air code, mind you):

Sub LineEmUpDano()
  Dim oSl as Slide
  Dim sngTop as Single

  ' Pick up the top position of the first shape
  ' on the first slide:
  SngTop = ActivePresentation.Slides(1).Shapes(1).Top

  ' Apply the top position to each slide in the pres
  For Each oSl in ActivePresentation.Slides
    oSl.Shapes(1).Top = sngTop
    ' you could instead use
    ' oSl.Shapes(1).Top = 42 ' or whatever value you like
    ' Values are in points, 72 points to the inch
  Next  ' slide
End Sub
0
votes

Using Steve's suggestion above as a jumping off point and then reading some tutorials I was able to come up with a working script:

Sub UniformHeight()
    Dim SlideToCheck As Slide
    Dim ShapeIndex As Integer

    For Each SlideToCheck In ActivePresentation.Slides
        For ShapeIndex = SlideToCheck.Shapes.Count To 1 Step -1
            SlideToCheck.Shapes(ShapeIndex).Top = 36
        Next
    Next
End Sub