Can anyone help with this macro

I've been trying to get ChatGPT to make a macro for me to resize selected objects by a percentage that I input

I want the objects to remain in their original position

It can resize the objects but it also resizes the space between them

I want the space to remain the same

Here is where "we're" at so far

=============================

Sub ResizeSelectedObjectsIndividuallyByPercentage()
' Prompt the user for the resize percentage
Dim resizePercentageInput As String
resizePercentageInput = InputBox("Enter the resize percentage (e.g., 120 for 120% increase):", "Resize Objects")

' Validate input
If IsNumeric(resizePercentageInput) Then
Dim resizePercentage As Double
resizePercentage = CDbl(resizePercentageInput)

' Convert percentage to scale factor
Dim scaleFactor As Double
scaleFactor = resizePercentage / 100

' Store original dimensions and centers
Dim shape As Shape
Dim originalCenters As Collection
Set originalCenters = New Collection

Dim originalWidths As Collection
Set originalWidths = New Collection

Dim originalHeights As Collection
Set originalHeights = New Collection

' Gather original positions and sizes
For Each shape In ActiveSelection.Shapes
originalCenters.Add Array(shape.CenterX, shape.CenterY) ' Store original center
originalWidths.Add shape.SizeWidth ' Store original width
originalHeights.Add shape.SizeHeight ' Store original height
Next shape

' Resize each shape and adjust positions
Dim i As Integer
For i = 1 To ActiveSelection.Shapes.Count
Set shape = ActiveSelection.Shapes(i)

' Get original dimensions
Dim originalWidth As Double
Dim originalHeight As Double
originalWidth = originalWidths(i)
originalHeight = originalHeights(i)

' Calculate new dimensions after resizing
Dim newWidth As Double
Dim newHeight As Double
newWidth = originalWidth * scaleFactor
newHeight = originalHeight * scaleFactor

' Set the new size
shape.SizeWidth = newWidth
shape.SizeHeight = newHeight

' Get the original center to keep the object centered
Dim originalCenterX As Double
Dim originalCenterY As Double
originalCenterX = originalCenters(i)(0)
originalCenterY = originalCenters(i)(1)

' Adjust the position to maintain the same center
shape.SetPosition originalCenterX - (newWidth / 2), _
originalCenterY - (newHeight / 2)
Next i

' Inform the user
MsgBox "Selected objects resized by " & resizePercentage & "% individually without changing positions."
Else
MsgBox "Please enter a valid numeric value.", vbExclamation, "Invalid Input"
End If
End Sub