There’s a great feature in PowerPoint 2013 (and some earlier versions) that lets you change a shape or a picture within a group, without having to ungroup it first. This is really useful if you have added animation to your group because ungrouping it to make edits is a pain due to loosing all of the group’s properties.

But what if you want to add a shape to a group without ungrouping it or simply to a single object you’ve already animated, again whilst maintaining the animation and other group properties such as its layer order and name?

Well, it can’t be done. Not easily anyway. But we’ve created this free macro that can help you out.

What the PowerPoint Macro does

You first need to select one group and one non-group object on your slide OR one animated object and one non-animated object. The macro will warn you if you haven’t done this.

Next, the macro saves various properties of your source group or shape such as the list of objects that make up the group, it’s name, the animation settings and order and finally, the layer position (also known as z-order).

If you’re using an animated group it then ungroups your group, causing all of the above properties to be lost.

The second object that you selected is now grouped with the other ungrouped object(s).

The new group then has it’s name reset, animation reapplied and z-order reset, all to match your original source group or object.

How to use the Macro

The simplest way to try the macro is to download the digitally signed PowerPoint .pptm file and follow the instructions.

Download PowerPoint .pptm

If you know how to use Alt+F8 to add a macro to an existing presentation, you can copy and paste the source code of the macro from below to your presentation.

'**********************************************************************
' Macro : AddShapeToGroup()
' Author : Jamie Garroch
' Date : 13 May 2014
' Updated : 26 August 2015 (to support single animated shapes)
' Copyright (c) YOUpresent Ltd. 2014 http://youpresent.co.uk
'**********************************************************************
' Purpose : Adds a shape to an existing multi-object group or animated
' single object while maintaining the source animation settings.
' Actions:
' 1. Looks for one group and one non-group in the user selection OR
' 2. Looks for one animated shape and one non-animated shape
' 3. Stores the animation settings and animation position of the group or shape
' 4. Stores the source group/shape name and layer position (z-order)
' 5. Ungroups the group, loosing the animation, its name and layer
' 5. Selects all the items from the original group/shape plus the new object
' 6. Creates a new group
' 7. Applies the original animation settings and animation position
' 8. Applies the original group's name and layer position
' Limitations:
' 1. Only works if the user group or shape has a single animation
' Caveats:
' 1. Only tested in PowerPoint 2013 32 bit on Windows 7 64 bit
'**********************************************************************

Option Explicit

Private Enum ypAddMode
  ypAddModeGroup
  ypAddModeShape
End Enum

Sub AddShapeToGroup()
  Dim AddMode As ypAddMode ' Adding to a group of shapes or a single shape
  Dim oGrp As Shape ' The user group
  Dim oAdd As Shape ' The user shape to add to the group
  Dim oShp As Shape ' Temporary object
  Dim oGrpItems As New Collection ' A collection of all shapes in the user group
  Dim userViewType As Variant ' The users selected view type
  Dim GrpName As String ' Name of the user group
  Dim CurSlide As Integer ' Index of the current slide
  Dim AnimPos As Integer ' Position of the group's animation within the slide animation sequence
  Dim counter As Integer ' Loop counter
  Dim Layer As Integer ' The layer (z-order) of the user group
  Dim LayerFlag As Boolean ' Flag to determine if the group is above the shape to be added

  ' Ignore errors, for example if an animation doesn't exist for the group an error will be generated
  On Error Resume Next

  With ActiveWindow.Selection

    ' Check that shapes are selected
    If Not .Type = ppSelectionShapes Then GoTo IncorrectSelection
    ' Check that 2 shapes are selected
    If Not .ShapeRange.Count = 2 Then GoTo IncorrectSelection

    ' Try to set references to one group and one non-group shape
    If .ShapeRange(1).Type = msoGroup Then
      Set oGrp = .ShapeRange(1)
      If Not .ShapeRange(2).Type = msoGroup Then _
        Set oAdd = .ShapeRange(2)
    Else
      If .ShapeRange(2).Type = msoGroup Then Set oGrp = .ShapeRange(2)
      If Not .ShapeRange(1).Type = msoGroup Then Set oAdd = .ShapeRange(1)
    End If

    ' If we don't have one group and one non-group, try to determine if we have one shape with and one shape without animation
    If oGrp Is Nothing Or oAdd Is Nothing Then
      If .ShapeRange(1).AnimationSettings.Animate And Not .ShapeRange(2).AnimationSettings.Animate Then _
        Set oAdd = .ShapeRange(2): Set oGrp = .ShapeRange(1): AddMode = ypAddModeShape
      If .ShapeRange(2).AnimationSettings.Animate And Not .ShapeRange(1).AnimationSettings.Animate Then _
        Set oAdd = .ShapeRange(1): Set oGrp = .ShapeRange(2): AddMode = ypAddModeShape
    Else
      AddMode = ypAddModeGroup
    End If

  End With

  ' If we haven't found one animated shape and one non animated shape or a shape and a group, exit
  If oGrp Is Nothing Or oAdd Is Nothing Then GoTo IncorrectSelection

  ' Store the user's view type
  userViewType = ActiveWindow.ViewType

  ' Get the current slide index
  CurSlide = ActiveWindow.View.Slide.SlideIndex

  ' Store the groups's animation position
  With ActivePresentation.Slides(CurSlide).TimeLine
    For counter = 1 To .MainSequence.Count
      'If .MainSequence(counter).DisplayName = oGrp.Name Then AnimPos = counter
      If .MainSequence(counter).Shape.Name = oGrp.Name Then AnimPos = counter
    Next
  End With

  ' Store the group's z-order
  Layer = oGrp.ZOrderPosition

  ' Set the layer flag to tru if the user group is above the user shape to be added
  If oGrp.ZOrderPosition > oAdd.ZOrderPosition Then LayerFlag = True

  ' Get the animation properties of the group if they exist
  oGrp.PickupAnimation

  ' Create the collection of shapes in the group else just the single shape
  If AddMode = ypAddModeGroup Then
    For Each oShp In oGrp.GroupItems
      oGrpItems.Add oShp
    Next
  Else
    oGrpItems.Add oGrp
  End If

  ' Store the user group's name
  GrpName = oGrp.Name

  ' Select the user group on its own
  oGrp.Select msoTrue

  ' Ungroup the user group, leaving all items selected
  If AddMode = ypAddModeGroup Then oGrp.Ungroup

  ' Make sure the shapes' view is active by switching to a random view and then back to the user's view
  ActiveWindow.ViewType = ppViewSlide
  ActiveWindow.ViewType = ppViewNormal
  ActiveWindow.ViewType = userViewType

  ' Select all of the shapes in the ungrouped collection
  For Each oShp In oGrpItems
    oShp.Select msoFalse
  Next

  ' Add the user object to be added to the group to the selection
  oAdd.Select msoFalse

  ' Group the original grouped items plus the new object
  Set oGrp = ActiveWindow.Selection.ShapeRange.Group

  ' Reapply the original animation
  oGrp.ApplyAnimation

  ' Move the recreated [last] animation to its original position
  With ActivePresentation.Slides(CurSlide).TimeLine
    .MainSequence(.MainSequence.Count).MoveTo AnimPos
  End With

  ' Move the group to the existing layer, taking into account where the group was in relation to the added shape
  Do While Not oGrp.ZOrderPosition = IIf(LayerFlag, Layer - 1, Layer)
    oGrp.ZOrder msoBringForward
  Loop

  ' Reset the group name
  oGrp.Name = GrpName

  ' Clean up
  Set oGrp = Nothing
  Set oAdd = Nothing
  Set oShp = Nothing
  Set oGrpItems = Nothing

  MsgBox "The shape was added to the group.", vbInformation + vbOKOnly, "Macro by YOUpresent.co.uk"

Exit Sub

IncorrectSelection:
  MsgBox "Please select one group and one non-group.", vbInformation + vbOKOnly, "Macro by YOUpresent.co.uk"
  Exit Sub

End Sub