Following the excellent answer to my

Expected Result

CodePudding user response：

A colleague of mine always tells me to use F8 to se what macros do, and all the above shows clearly I did not do it. Not enough. I realized I was trying to group the items while in the function, when in fact this should have occurred in the macro itself, after the ungrouping. I took inspiration from this answer (keeping in mind the comment right below it: shapes must have different names) and now everything is working as expected.

One thing I do not understand: at the line Debug.Print Parent.name the Immediate Window says Microsoft Excel, but I am running this in PowerPoint and Excel is closed.

Sub GiveNamesToShapes_Center_AndThenRegroup()
    Dim oSlide As slide
    Set oSlide = ActivePresentation.Slides(ActiveWindow.View.slide.SlideIndex)
    
    Dim x As Long
    Dim sTemp As String
    
    Dim ShapeList() As String
    Dim ShapeCount As Long
    
    Dim TextList() As String
    Dim TextCount As Long
    
    Dim shp As Shape
    For Each shp In oSlide.shapes
        If shp.Type = msoGroup Then
            NameGroup shp
            
        Else
        
                For x = 1 To oSlide.shapes.Count

            If oSlide.shapes(x).TextFrame.HasText = msoFalse Then
                ShapeCount = ShapeCount   1
                
                
            Else
                TextCount = TextCount   1
            End If
        Next


        ReDim ShapeList(1 To ShapeCount)
        ReDim TextList(1 To TextCount)

        ShapeCount = 0
        TextCount = 0

        For x = 1 To oSlide.shapes.Count

            If oSlide.shapes(x).TextFrame.HasText = msoFalse Then
                ShapeCount = ShapeCount   1
                ShapeList(ShapeCount) = oSlide.shapes(x).name
                
            Else
                TextCount = TextCount   1
                TextList(TextCount) = oSlide.shapes(x).name
            End If
        Next

        If UBound(ShapeList) > 0 Then
            oSlide.shapes.Range(ShapeList).Group
        End If
        If UBound(TextList) > 0 Then
            oSlide.shapes.Range(TextList).Group
        End If
            

        End If
    Next shp
End Sub

Function NameGroup(ByVal oShpGroup As Object) As Long
    Dim groupName As String, shp As Shape, shpRng As ShapeRange, txt As String
    

    
    Dim Shp_Cntr As Double
    Dim Shp_Mid As Double
    
    Dim ShapeLeft As Double
    Dim ShapeTop As Double
    Dim ShapeWidth As Double
    Dim ShapeHeight As Double
    
    
    groupName = oShpGroup.name
    Debug.Print oShpGroup.name
    Dim oSlide As slide: Set oSlide = oShpGroup.Parent
    Debug.Print Parent.name

    Set shpRng = oShpGroup.Ungroup
    For Each shp In shpRng
        If Not shp.Type = msoGroup Then
            If shp.TextFrame.HasText = msoTrue Then _
                txt = shp.TextFrame.TextRange.text
        End If
    Next shp
    For Each shp In shpRng
        If Not shp.Type = msoGroup Then
            If shp.TextFrame.HasText = msoFalse Then
            
                shp.name = txt
            
                ShapeLeft = shp.Left

                ShapeTop = shp.Top

                ShapeWidth = shp.Width

                ShapeHeight = shp.Height

                
                Shp_Cntr = ShapeLeft   ShapeWidth / 2
                Shp_Mid = ShapeTop   ShapeHeight / 2

            Else

                With shp
                                shp.name = "Textbox " & txt
                    .TextFrame.WordWrap = False
                    .TextFrame.AutoSize = ppAutoSizeShapeToFitText
                    .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
                    .TextFrame.VerticalAnchor = msoAnchorMiddle
                    
                    .Left = Shp_Cntr - (.Width / 2)
                    .Top = Shp_Mid - (.Height / 2)
                End With


            End If
        End If
    Next shp
    

    Dim ids() As Long, i As Long: ReDim ids(1 To shpRng.Count): i = 1
    For Each shp In shpRng
        If shp.Type = msoGroup Then

             NameGroup shp

        End If
    Next shp

End Function