PPT: Sample Code to Center a Selection of Objects (162247)

MORE INFORMATION

Sample Visual Basic Procedure

 Sub CenterShape()

      ' Object reference to a shape.
      Dim ShapeObject As Shape

      ' Holds the center of the slide.
      Dim SlideCenter As Long

      ' Holds the center of a shape.
      Dim ShapeCenter As Long

      ' Stores the number of shapes.
      Dim lNumberOfShapes As Long

      ' Variable to store the selection type.
      Dim lSelectionType As Long

      ' Variables used to build the error message.
      Dim ErrorMessage As String
      Dim ErrorWindowTitle As String

      ' Variables used to build the success message.
      Dim Message As String
      Dim WindowTitle As String

      ' Holds the number of shapes centered.
      Dim count As Long

      ' Stores the selection type.
      lSelectionType = ActiveWindow.Selection.Type

      ' Checks whether selection is a shape.
      If lSelectionType <> ppSelectionShapes Then

         Select Case lSelectionType

           ' The selected item is a slide.
            Case ppSelectionSlides
               ErrorMessage = "You have a slide selected. "
               ErrorWindowTitle = "Slide Selected"

            ' The selected item is text.
            Case ppSelectionText
               ErrorMessage = "You have text selected. "
               ErrorWindowTitle = "Text Selected"

            ' Nothing is selected.
            Case ppSelectionNone
               ErrorMessage = "You have nothing selected. "
               ErrorWindowTitle = "Nothing Selected"

            Case Else
               ErrorMessage = "A problem with you selection. "
               ErrorWindowTitle = "Unkown Error"
         End Select

         ' Build the rest of the error message.
         ErrorMessage = ErrorMessage & "Please select a " _
            & "shape and run the macro again."

         ' Display the error message.
         MsgBox ErrorMessage, vbExclamation, ErrorWindowTitle

         ' Stop the macro.
         End
      End If

      ' Calculates the center of the slide.
      SlideCenter = ActivePresentation.PageSetup.SlideWidth \ 2

      ' Initializes the count before using it.
      count = 0

      ' Centers each object as the loop goes through.
      For Each ShapeObject In ActiveWindow.Selection.ShapeRange
         ShapeCenter = ShapeObject.Width \ 2
         ShapeObject.Left = SlideCenter - ShapeCenter
         count = count + 1
      Next ShapeObject

      ' Builds the success message.
      WindowTitle = "Macro Completed"
      Message = "Successfully centered "
      If count = 1 Then
         Message = Message & "1 object."
      Else
         Message = Message & count & " "
         Message = Message & "objects"
      End If

      ' Displays the message box.
      MsgBox Message, vbInformation, WindowTitle

   End Sub