Link to home
Create AccountLog in
Avatar of dabug80
dabug80

asked on

PowerPoint: Arrange many images on a slide easily?

Hi,

I have a PowerPoint slide with many (30) small images. Is there an easy way to arrange these in a grid format, without having to individually move them or move them in sub-groups? Ideally I could just select them all and click - arrange to a grid formation.

Thanks.
ASKER CERTIFIED SOLUTION
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Another option is some VBA...
As noted in the macro, it will place the selected shapes in a grid based on the size of the biggest shape  and the space defined in "dSpc". It places the first column half way what's left of the slide depending on the number of columns and the max size of the shapes

It assumes you don't have too many shapes, since the way it is set up it will create as many rows as needed, possibly extending beyond the bottom of the slide.

Paste the code into a module of the presentation, select the shapes to move and run the macro.

Option Explicit
Sub ArrangeShapes()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'The macro places the selected shapes in a grid based on the size of the biggest shape
'  and the space defined in "dSpc". It places the first column half way what's left of the slide
'  depending on the number of columns and the max size of the shapes
'  NOTE: It will create as many rows as needed, possibly extending beyond the bottom of the slide
'Author: Jörgen Möller, 21Jul2016
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim dWdt As Double, dHgt As Double, dSpc As Double, dStart As Double
Dim dMaxW As Double, dMaxH As Double, dLft As Double, dTop As Double, iCols As Integer
Dim sShps As Variant, shp As Variant, r As Integer, c As Integer
    dSpc = 10
    dWdt = ActiveWindow.Selection.SlideRange.Master.Width   'The width of the slide
    dHgt = ActiveWindow.Selection.SlideRange.Master.Height  'The height of the slide
    Set sShps = ActiveWindow.Selection.ShapeRange           'The selected shapes
    
    For Each shp In sShps   'Loop through all selected shapes to find max width and height
        If dMaxW < shp.Width Then dMaxW = shp.Width
        If dMaxH < shp.Height Then dMaxH = shp.Height
    Next shp
    
    iCols = Int(dWdt / (dMaxW + dSpc))              'Calculate # of columns
    dStart = (dWdt - iCols * (dMaxW + dSpc)) / 2    'Calculate the remainder of the width to decide where to start
    
    r = 1
    For Each shp In sShps
        If c < iCols Then c = c + 1 Else c = 1: r = r + 1   'Define column# and row#
        shp.Left = dStart + (c - 1) * (dMaxW + dSpc)        'Place the shape in the right column
        shp.Top = (r - 1) * (dMaxH + dSpc)                  'Place the shape in the right row
    Next shp
End Sub

Open in new window

SOLUTION
Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of dabug80
dabug80

ASKER

Thanks