Solved: Autoplace shapes around the center

[TrippyTom]

Hi guys,

I want to make a macro that will take the current selection and automatically distribute it in a circle around the center of a slide.

Is there a PI constant in Powerpoint VBA? I could use that and the SIN and COS functions to figure out the angle and put the placement routine in a for/next loop.

[shades]

Howdy. Since VBA/PPT will only get a few decimal places, why not set your own value for pi?

Pi=3.14159265358979323846264338327950288419716939937510

[TrippyTom]

Is that from memory? wow

Update: I got it to place it in a circle - but it's putting it in the upper left corner. I'm sure I missed something in my code. I will update you if I ever figure it out.

[shades]

Is that from memory? wow

Update: I got it to place it in a circle - but it's putting it in the upper left corner. I'm sure I missed something in my code. I will update you if I ever figure it out.

At one time in college (40 years ago) I had about 20 places memorized, but cob webs have gotten thick with age.

I suspect that starting reference is upper left, rather than center. And remember that you have both horizontal and vertical measurements for the center.

[TrippyTom]

Ok, here's what I ended up with. I put this code on my userform. It's probably not the most streamlined of code, but it works great for me.
[vba]
Private Sub btn_Cancel_Click()
Call btn_reset_Click
Unload Me
End Sub
Private Sub btn_OK_Click()
Dim oLines As Long 'number of line divisions
Dim dpi As Long
Dim pageX As Single
Dim pageY As Single
Dim radiusX As Double
Dim radiusY As Double
Dim resultX As Double
Dim resultY As Double
Dim i As Long
Dim myAngle As Single
Dim myPi As Single
myPi = 3.14159265358979
dpi = 72 'dpi value (normally 72)
If Not tb_X.Value = "" Or Not tb_Y.Value = "" Then
oLines = ActiveWindow.Selection.ShapeRange.Count
For i = 1 To oLines
With ActiveWindow.Selection.ShapeRange(i)
If opt_noPM.Value = True Then
pageX = 356.4
pageY = 266.4
ElseIf opt_PM.Value = True Then
pageX = 356.4
pageY = 293.76
End If
radiusX = tb_X.Value * dpi / 2
radiusY = tb_Y.Value * dpi / 2
myAngle = (i * (myPi * 2)) / oLines
resultX = (-Cos(myAngle) * radiusX) + pageX 'X value
resultY = (-Sin(myAngle) * radiusY) + pageY 'Y value
.left = resultX
.top = resultY
End With
Next i

Call btn_reset_Click
Unload Me
End If
End Sub
Private Sub btn_reset_Click()
tb_X = ""
tb_Y = ""
End Sub
[/vba]

[TrippyTom]

And I discovered if the shapes are progressively larger it gives it a sort of spiral effect. Pretty cool: