Option Explicit
Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    Select Case ContentControl.Title
        Case "Purpose"
        ActiveDocument.Fields.Update
            Select Case ContentControl.Range.Text
                Case "End of Life"
                    InsertBBinBM "BoxInstruct", "InstructEoL"
                Case Else
                    InsertBBinBM "BoxInstruct", "InstructElse"
            End Select
        Case Else
            'The user exited some other content control that we don't care about.
    End Select
lbl_Exit:
    Exit Sub
End Sub
Sub InsertBBinBM(ByRef BMTarget As String, BBName As String)
'The above calls out the sub-procedure asked for: InsertBBinBM, and the two properties...
'...it refers to (target bookmark, building block name).
Dim rng As Word.Range
Dim cc As ContentControl
    'ERROR Unlock the document by ungrouping all objects.
    'Set target range for the bookmark being inserted.  This is the bookmark "BoxInstruct" range.
    Set rng = ActiveDocument.Bookmarks(BMTarget).Range
    'Unlock any content controls in the range so that it can be cleared!  For Each statements have to per-variable, hence different variables every time for the same range.
    'For Each statements have to have unique variables, so create a unique label for the content controls being unlocked.
    Dim rccO As ContentControl
        For Each rccO In ActiveDocument.ContentControls
            rccO.LockContentControl = False
            Next rccO
    'Clear the target range to ensure the bookmark range is empty of previous content.  This only works if the content controls are not locked!
    rng.Delete
    Application.ScreenUpdating = False
    If Not BBName = " " Then
        'Tell the range to insert the building block (gallery: Custom 1, Category "InstaForm"...
        '...and then the name that you defined in your select case argument above.
        Set rng = ActiveDocument.AttachedTemplate.BuildingBlockTypes(wdTypeCustom1).Categories("InstaForm").BuildingBlocks(BBName).Insert(rng, True)
    Else
        rng.Text = ""
    End If
    'Lock all content controls again.
    Dim rccI As ContentControl
        For Each rccI In ActiveDocument.ContentControls
            rccI.LockContentControl = True
            Next rccI
    'Recreate the the bookmark.
    ActiveDocument.Bookmarks.Add BMTarget, rng
    'ERROR Re-group all objects to effectively lock the document from editing again.
    Application.ScreenUpdating = True
End Sub

    
Dim sO As Shapes
   For Each sO In ActiveDocument.Shapes
        sO.Ungroup
        Next sO

ActiveDocument.Shapes.SelectAll
  Shapes.Ungroup

    'Selecting all with ctrl+A
    Selection.WholeStory
    'Hitting Developer > Controls > Ungroup
    Selection.Range.ParentContentControl.Ungroup
    'Selecting all with ctrl+A
    Selection.WholeStory
    'Developer > Controls > Group
    Selection.Range.ContentControls.Add (wdContentControlGroup)

    For Each cc In ActiveDocument.ContentControls
        If cc.Type = wdContentControlGroup Then
            cc.Ungroup
        End If
    Next cc

    '(Re)Group all objects to effectively lock the document from editing again.
    Dim ctrlA As Word.Range
    Dim ctrlAcc As ContentControl
        Set ctrlA = ActiveDocument.Range
        ctrlA.Select
    Set ctrlAcc = ActiveDocument.ContentControls.Add(wdContentControlGroup, ctrlA)