We help IT Professionals succeed at work.

Distributing multiple objects randomly in PowerPoint

Hello,

Commonly when working in PowerPoint (2010), I have the need to randomly scatter multiple small objects throughout some particular area.  Is there any function or command in PowerPoint that will do this automatically?  If not, are there other commands or tricks which enable it to be done in an easier and quicker way than manually?

For example, suppose you have the following slide which contains a small oval object measuring 0.2 x 0.3 inches and a square measuring 5 x 5 inches (Fig. 1).
 1
Now, suppose you want to turn that into a slide in which 200 of the small objects are distributed randomly inside the square.

The first thing I would typically do is to duplicate (Ctrl+D) the object 20 times (Fig. 2) then duplicate the 20 objects 10 more times (Fig. 3).
 2 3
The obvious problem now however, is that you are faced with a long and tedious process of moving the objects one-by-one into random positions in the square.

I have been able to shorten this process somewhat in the past by creating a random pattern of say 10-20 objects and then duplicating that.  However, even then, a repeating or nonrandom pattern is usually still apparent.

It sure would be nice to be able to have a "Random Scatter" box in which you could specify the area shape and parameters and then designate some object and enter how many duplicates you want.  Then with a single click, it would distribute the number of objects randomly throughout the area you specified thus, quickly giving you what you are after.  Better yet, would be the ability to apply some kind of concentration gradient for the object distribution similar to the way colors can be filled into an object along a gradient.

Any suggestions or thoughts are most appreciated!

Thanks
Comment
Watch Question

CERTIFIED EXPERT
Most Valuable Expert 2011
Awarded 2010
Commented:
Hello Steve,

instead of individual shapes, you could add a XY Scatter chart with 200 data points. Fill the source data with the formula

=Randbetween(1,100)

and set the X and Y axis to a max value of 100, remove axis and grid lines and format the data markers to suit (i.e. you can use a picture fill if you need a specific shape). Drag the chart to the desired size and shape.

When you want a new, random distribution, edit the data source and hit F9

See attached.

cheers, teylyn
Presentation1.pptx
CERTIFIED EXPERT

Commented:
wow
CERTIFIED EXPERT

Commented:
teylyn gets a raise for that ;)

Author

Commented:

I can't really add any verbiage to Brian's "wow" (except maybe an exclamation mark) because he pretty well summed it up!  However, maybe I can contribute some audio:

Brtrtrtrtrtrtrtrtrtrt -- drumroll as teylyn is typing her post followed by a tympani crescendo building to a cymbal crash as she clicks "Submit" giving way to a full-orchestra fanfare centered on a magnificent motif played by the strings -- most prominently the cellos of course -- when it is published!  Then a simple but poignant gong each time an unsuspecting reader realizes what they just read.   :)

I wish EE would give us (frequent question askers) 2 or 3 "coupons" -- worth 1000 or 2000 points each -- to award during the year for above-and-beyond effort or above-and-out-of-the-box thinking.  This would be a perfect time to use one!

Author

Commented:
>>teylyn:
...format the data markers to suit (i.e. you can use a picture fill if you need a specific shape).


teylyn,

I got everything in your instructions except I am not sure what you mean for formatting the data markers -- especially by using picture fill to get a specific shape.  For example, how could I change the data markers to the oval included in my initial post?  Can you elaborate or give some specific steps re how to do that?

Thanks again for the awesome answer!
CERTIFIED EXPERT
Most Valuable Expert 2011
Awarded 2010

Commented:
Hello Bright,

not sure I can write straight after reading the accolades. Thanks, guys!

To use an image as a data marker, you need that image on your hard drive somewhere. A JPG or GIF or PNG file will do. Then

- click a data point in the chart and open the dialog to format the chart series.
- Select "Marker Fill" in the left hand panel
- Select "Picture or texture fill"
- Click the File button under "insert from" (or insert from clipboard or Clip Art (please, no Clip Art!))
- Follow the dialog.
- finally, select "Marker Line Color" in the left hand panel and set to "No line", otherwise the data markers will have a thin line.
- bump up the size of the data markers with the size settings under "Marker Options"

Attached is another version and a few PNG files that could be used as images for the fill.

cheers, teylyn

Presentation1.pptx
button-red.png
button-blue.png
button-green.png
CERTIFIED EXPERT
Most Valuable Expert 2011
Awarded 2010

Commented:
Just noticed that the picture fill will only extend to the borders of the selected marker shape.

Another option to use an image as a data marker is

- click a data point in the chart and open the dialog to format the chart series.
- Select "Marker Options" in the left hand panel
- Select "Built-in" and scroll to the image icon at the bottom of the list
- select the icon and a dialog will open where you can select an image.

cheers,

Author

Commented:
Great.  Thanks.

One more (very basic) quick question.  How can I shrink a picture and save it as a much smaller image?  I don't know why that is causing me grief but I have tried a couple of things like zooming out in Paint and re-saving, etc., but it always gets saved at the original size.  Maybe it's too late for me to be doing this.  :p
CERTIFIED EXPERT
Most Valuable Expert 2011
Awarded 2010

Commented:
A proper image editing software would be better than MS Paint.

If you have Office 2010, you can use the image editor that comes with it. Locate the file in Windows Explorer, right-click and from the context menu select "Open with > Microsoft Office 2010" (funny title, but that's what it is).

The application has arrows at the bottom of the screen to flick through the images in the current folder. It also has a menu called "Picture" which sports a "Resize" option.  Go for the percentage resize box to maintain the aspect ratio of the image and hit OK. Save with a new file name.

It's far from the best tool to edit images but better than Paint.

cheers, teylyn
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
Steve,
I took teylyn's approach as a starting point and wrote a macro in PowerPoint VBA to copy a shape onto a rectangular canvas with randomized distribution, gradient distributions, the possibility of randomized rotation, randomized size and arbitrary number. As written, the calling routine assumes that you have only two shapes on the slide: the canvas (Shapes(1)) and the shape to be sprinkled randomly (Shapes(2)).

'Calling routine in slide code pane
Sub Test()
With Me
    '.Shapes(1) and .Shapes(2) are the canvas and shape to be sprinkled randomly
    'Add 200 shapes to the canvas
    'Rotate them randomly
    'Randomly change the size between 80% and 120%
    Sprinkles .Shapes(1), .Shapes(2), 200, "Lower right to upper left", True, 80, 120
End With
End Sub


'Sub that does all the work, in a regular module sheet
Sub Sprinkles(shpCanvas As Shape, shpSprinkle As Shape, nSprinkles As Integer, sGradientType As String, _
                Optional bRotate As Boolean = False, Optional sSizeMin As Single = 100, Optional sSizeMax As Single = 100)
Dim i As Integer
Dim shp As Shape
Dim shpRg As ShapeRange
Dim sngHeight As Single, sngLeft As Single, sngSize As Single, sngSprinkleHeight As Single, sngSprinkleWidth As Single, _
    sngTop As Single, sngWidth As Single, x As Single, y As Single, theta As Single
With Application.ActivePresentation.Slides(1)
    sngSprinkleHeight = shpSprinkle.Height * sSizeMax / 100
    sngSprinkleWidth = shpSprinkle.Width * sSizeMax / 100
    If bRotate Then
        If sngSprinkleHeight > sngSprinkleWidth Then
            sngSprinkleWidth = sngSprinkleHeight
        Else
            sngSprinkleHeight = sngSprinkleWidth
        End If
    End If
    sngTop = shpCanvas.Top + sngSprinkleHeight / 2
    sngHeight = shpCanvas.Height - sngSprinkleHeight
    sngLeft = shpCanvas.Left + sngSprinkleWidth / 2
    sngWidth = shpCanvas.Width - sngSprinkleWidth
    For i = 2 To nSprinkles
        Select Case sGradientType
        Case "Uniform"
            x = sngWidth * Rnd()
            y = sngHeight * Rnd()
        Case "Top to bottom"
            x = sngWidth * Rnd()
            y = sngHeight * Rnd() ^ 2
        Case "Bottom to top"
            x = sngWidth * Rnd()
            y = sngHeight * (1 - Rnd() ^ 2)
        Case "Left to right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * Rnd()
        Case "Right to left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * Rnd()
        Case "Upper right to lower left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * Rnd() ^ 2
        Case "Lower left to upper right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * (1 - Rnd() ^ 2)
        Case "Upper left to lower right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * Rnd() ^ 2
        Case "Lower right to upper left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * (1 - Rnd() ^ 2)
        End Select
        shpSprinkle.Copy
        Set shpRg = .Shapes.Paste
        shpRg.Top = sngTop + y
        shpRg.Left = sngLeft + x
        Set shp = shpRg.Item(1)
        With shp
            If bRotate Then .IncrementRotation 360 * Rnd()
            If sSizeMin <> sSizeMax Then
                sngSize = (sSizeMin + (sSizeMax - sSizeMin) * Rnd()) / 100
                .ScaleHeight sngSize, msoFalse, msoScaleFromMiddle
                .ScaleWidth sngSize, msoFalse, msoScaleFromMiddle
            End If
        End With
    Next
End With
End Sub

Open in new window


Brad
SprinklesQ27426372.ppt
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
I added a userform to select the various options for distributing the shapes on the canvas. I also fixed an error by which the shapes might overhang the edge of the canvas.

Open the presentation, enable macros and press the present icon. You may now press a command button to launch the macro as many times as you would like.

Sub Sprinkles(shpCanvas As Shape, shpSprinkle As Shape, nSprinkles As Integer, sGradientType As String, _
                Optional bRotate As Boolean = False, Optional sSizeMin As Single = 100, Optional sSizeMax As Single = 100)
Dim i As Integer
Dim shp As Shape
Dim shpRg As ShapeRange
Dim sngHeight As Single, sngLeft As Single, sngSize As Single, sngSprinkleHeight As Single, sngSprinkleWidth As Single, _
    sngTop As Single, sngWidth As Single, x As Single, y As Single, theta As Single
With Application.ActivePresentation.Slides(1)
    sngSprinkleHeight = shpSprinkle.Height * sSizeMax / 100
    sngSprinkleWidth = shpSprinkle.Width * sSizeMax / 100
    If bRotate Then
        If sngSprinkleHeight > sngSprinkleWidth Then
            sngSprinkleWidth = sngSprinkleHeight
        Else
            sngSprinkleHeight = sngSprinkleWidth
        End If
    End If
    sngTop = shpCanvas.Top + (sngSprinkleHeight - shpSprinkle.Height) / 2
    sngHeight = shpCanvas.Height - sngSprinkleHeight
    sngLeft = shpCanvas.Left + (sngSprinkleWidth - shpSprinkle.Width) / 2
    sngWidth = shpCanvas.Width - sngSprinkleWidth
    For i = 2 To nSprinkles
        Select Case sGradientType
        Case "Uniform"
            x = sngWidth * Rnd()
            y = sngHeight * Rnd()
        Case "Top to bottom"
            x = sngWidth * Rnd()
            y = sngHeight * Rnd() ^ 2
        Case "Bottom to top"
            x = sngWidth * Rnd()
            y = sngHeight * (1 - Rnd() ^ 2)
        Case "Left to right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * Rnd()
        Case "Right to left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * Rnd()
        Case "Upper right to lower left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * Rnd() ^ 2
        Case "Lower left to upper right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * (1 - Rnd() ^ 2)
        Case "Upper left to lower right"
            x = sngWidth * Rnd() ^ 2
            y = sngHeight * Rnd() ^ 2
        Case "Lower right to upper left"
            x = sngWidth * (1 - Rnd() ^ 2)
            y = sngHeight * (1 - Rnd() ^ 2)
        End Select
        shpSprinkle.Copy
        Set shpRg = .Shapes.Paste
        shpRg.Top = sngTop + y
        shpRg.Left = sngLeft + x
        Set shp = shpRg.Item(1)
        With shp
            If bRotate Then .IncrementRotation 360 * Rnd()
            If sSizeMin <> sSizeMax Then
                sngSize = (sSizeMin + (sSizeMax - sSizeMin) * Rnd()) / 100
                .ScaleHeight sngSize, msoFalse, msoScaleFromMiddle
                .ScaleWidth sngSize, msoFalse, msoScaleFromMiddle
            End If
        End With
    Next
End With
End Sub

Open in new window


FWIW, getting this code to work as desired has been a blast.

NOTE: If you delete my explosion shape and replace it with your own, then the statement calling the Sprinkle sub will need to be changed to refer to the correct object for the second parameter. Most likely, the change will be to .Shapes(3) instead of .Shapes(2)

Brad
SprinklesQ27426372.ppt
CERTIFIED EXPERT
Most Valuable Expert 2011
Awarded 2010

Commented:
Brad, I think it was Dave Brett who said that you should sell your wife, divorce your house, get a new name, move to a different town and do anything you can to obscure your identity, before you start developing VBA for PowerPoint.

I can see his point. Anyone who writes that kind of stuff for free would want to be under cover.

:-)))

Author

Commented:
"BIG DILEMMA!"....no... actually, it is more accurate to say "BIGGER DILEMMA!"  

I already arrived at the big dilemma above after reading teylyn's first post and lamenting that I only had a measly 500 points to award for her remarkable solution.  Therefore, Brad's remarkable solution creates an even bigger dilemma because that "measly" 500 points is no more commensurate with his solution than it was with teylyn's!  (I better hurry and close this before someone else -- Barry, e.g. -- comes along and post's one of his remarkable solutions, making it a, BIGGEST DILEMMA!)

I honestly do not know what to do so I am just going to punt and award the points to teylyn, as I have been intending to do ever since reading her post.  Unfortunately, that leaves nothing for Brad -- except of course, my admiration and appreciation -- which I hope suffices.

Thanks again to both of you!
I joined this site just to say thank you- Teylyn, you are fantastic.
thanks very much for sharing this.