Autres Possibilité de faire une macro?

Sub CentrerRectangle()
    Dim o As Object
    For Each o In DrawingObjects
        o.Left = [G1].Left + ([G1].Width - o.Width) / 2
    Next
End Sub

DrawingObjects

Sub CentrerShapes()
   Dim Shp As Shape, Rng As Range
   For Each Shp In ActiveSheet.Shapes
      If Shp.Name Like "Rect*" Then CentrerShape Shp, _
         Application.Range(Shp.TopLeftCell, Shp.BottomRightCell)
      Next Shp
   End Sub
Sub CentrerShape(ByVal Shp As Shape, ByVal Rng As Range)
   Shp.Left = Rng.Left + (Rng.Width - Shp.Width) / 2
   Shp.Top = Rng.Top + (Rng.Height - Shp.Height) / 2
   End Sub

Sub CentrerShapesPour()
   Dim Shp As Shape, Rng As Range
   For Each Shp In ActiveSheet.Shapes
      If Shp.Name Like "Pour:*" Then CentrerShape Shp, ActiveSheet.Range(Mid$(Shp.Name, 6))
      Next Shp
   End Sub

ActiveSheet.DrawingObjects

Sub CentrerRectangle()
    Dim o As Object
     ActiveSheet.DrawingObjects
        o.Left = [G1].Left + ([G1].Width - o.Width) / 2
    Next
End Sub

Sub CentrageDesFormes()     'Placer le rectangle dans la 1ère & dernière colonne avant le centrage
Dim Sh As Shape
Dim Ws As Worksheet
  For Each Ws In Sheets
    For Each Sh In Ws.Shapes
      Select Case Sh.Type
        Case 1, 17
          If Sh.TopLeftCell.Address(0, 0) = "A1" Then
            Sh.Left = (Sh.BottomRightCell.Left + Sh.BottomRightCell.Width) / 2 - Sh.Width / 2
          End If
      End Select
    Next Sh
  Next Ws
End Sub