Center one or more objects on a slide (ideal for pies and shapes)

[RayKay]

Hi John

I have this code below, on my PC it centers more than one object, on my laptop it gives a horrible error box as it only centers one object. The Error Handler fails.

Any way it can work with one or more objects selected? And give an error message if no object is Selected? (Or if it will only ever work with one object, give an error message if two or more are selected?). I'm stuck. I'm sure lots of people will find this useful :) Thanks in advance!


Sub CenterObjectOnSlide()

Dim Obj As Object
Dim Obj_Left As Long
Dim Obj_Top As Long

'Set Sld variable equal to Current Slide Being Viewed
Set Sld = Application.ActiveWindow.View.Slide

'Set Obj Variable equal to Current Selected Object
On Error GoTo Select_Object
Set Obj = ActiveWindow.Selection.ShapeRange
On Error GoTo 0

'Center the Object Horizontally and Vertically
With ActivePresentation.PageSetup
Obj_Left = Obj.Left
Obj_Top = Obj.Top

'Center Horizontally
Obj.Left = (.SlideWidth \ 2) - (Obj.Width \ 2)

'Center Vertically
Obj.Top = (.SlideHeight \ 2) - (Obj.Height \ 2)

End With

Exit Sub

'Error Handler In Case No Object is Currently Selected
Select_Object:
MsgBox "Please select ONE object (or Grouped Object)"

End Sub

[John Wilson]

You can centre selected shapes on the slide like this. You should add some error checks


Sub centre()
' add some error checking to see
' if objects are selected
With ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With
End Sub

msoTrue = Align to SLIDE

[RayKay]

Thanks John

I can't seem to get my error code working?

Sub CenterObjectOnSlide()


With ActiveWindow.Selection.ShapeRange
If .Count <> 1 Then
MsgBox "Please select one or more objects"
Exit Sub
Else
With ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With


End Sub


And not sure what you meant by:

msoTrue = Align to SLIDE[/QUOTE]

Sorry, I'm trying to learn VBA in depth, just need a push here and there. Thank you.

[John Wilson]

Sub centre()
On Error GoTo err
With ActiveWindow.Selection.ShapeRange
'set to msoTrue to align to slide
'set to msoFalse to align to shapes
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With
Exit Sub ' usual exit
err: 'error
MsgBox "Error, Have you selected shapes?"
End Sub