Create Centered Shapes beneath selected ones

Question

I wrote code to create circles beneath selected objects in a slide.

1. The total shapes it can work on is limited to 100 (or whatever number I choose).
   How to set it to any value?
   I tried to enter "n", "x" and others. Debug would not let it through.
2. More importantly, the newly created shapes seem to be aligned, however at a closer look they need manual intervention to correct the positioning.
3. The behavior does not seem consistent across files: on the .pptm where the macro is stored the shapes are perfect circles (no matter if the selection is made of squares or rectangles), on another one they are distorted.

Sub CreateNewShapeAndAlign()

    Dim Shp(1 To 100) As Shape
    Dim Shp_Cntr As Long
    Dim Shp_Mid As Long
    Dim New_Shapes As Shape
    Dim Ratio As Double
    Dim x, y As Integer

    Ratio = 1.4

    Set myDocument = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
    
    For Each Shp(1) In ActiveWindow.Selection.ShapeRange

        Shp_Cntr = Shp(1).Left + Shp(1).Width / 2
        Shp_Mid = Shp(1).Top + Shp(1).Height / 2
    
        x = ActiveWindow.Selection.ShapeRange.Count
    
        For y = 1 To x
            If Shp(1) Is Nothing Then
                Set Shp(1) = ActivePresentation.Slides.Range.Shapes(y)
            Else
                Set Shp(y) = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber).Shapes(y)
            End If
        Next y
    
        Set New_Shape = myDocument.Shapes.AddShape(Type:=msoShapeOval, Left:=Shp_Cntr - ((Shp(1).Width * Ratio) / 2), Top:=Shp_Mid - ((Shp(1).Height * Ratio) / 2), Width:=Shp(1).Width * Ratio, Height:=Shp(1).Height * Ratio)
        New_Shape.Fill.ForeColor.RGB = RGB(100, 100, 100)
        New_Shape.Line.Visible = msoFalse
    
    Next

    ActiveWindow.Selection.ShapeRange.ZOrder msoBringToFront    

End Sub

Answer 1

Below the working code:

1. I removed any reference to the number of shapes, it was that easy
2. The alignment is fixed by setting the variables center and middle to Single (as per clarification by Steve Rindsberg above)
3. I forced the shapes to be circles by passing the width value to the height

I further cleaned up and removed unnecessary loops I had left from previous attempts at aligning the shapes. I guess variable Ratio should be Single as well, however I don't think it matters so much as it has only two digits after the comma so there is nothing to round.

Sub CreateUnderneath()
    
        Dim Shp As Shape
        Dim Shp_Cntr As Single 'Center of Selected Shapes
        Dim Shp_Mid As Single  'Middle of Selected Shapes
        Dim New_Shape As Shape
        Dim Ratio As Double    'Size of new shape relative to selected one underneath

        Ratio = 1.45
          
        Set myDocument = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
                
    If ActiveWindow.Selection.Type = 0 Then
        MsgBox "Nothing has been selected"
    Else
        
        For Each Shp In ActiveWindow.Selection.ShapeRange'.GroupItems 'to have it work inside groups
        
            Shp_Cntr = Shp.Left + Shp.Width / 2
            Shp_Mid = Shp.Top + Shp.Height / 2
    '        Circle
            Set New_Shape = myDocument.Shapes.AddShape(Type:=msoShapeOval, Left:=Shp_Cntr - ((Shp.Width * Ratio) / 2), Top:=Shp_Mid - ((Shp.Width * Ratio) / 2), Width:=Shp.Width * Ratio, Height:=Shp.Width * Ratio)
            New_Shape.Fill.ForeColor.RGB = RGB(0, 0, 0)
            New_Shape.Line.Weight = 0.75
            New_Shape.Line.Visible = msoFalse
            New_Shape.LockAspectRatio = msoTrue
            New_Shape.Name = "ShepeBelow"
        Next
    
        ActiveWindow.Selection.ShapeRange.ZOrder msoBringToFront

    End If
  
End Sub