Align all shapes to the center of their cell

[nugol]

Hy,

I try to align all shapes in my workbook to the center of their respective cell.
I found a solution to align one selected shape and I know how to select all shapes of a workbook.

But I don't get how to align all selected shapes.

That is the solution for aligning one selected shapes.

Sub pictest()
  Dim vSel As Variant
  Dim rngZ As Range
  Set vSel = Selection
  If VarType(vSel) = vbObject Then
    With vSel
      Set rngZ = .TopLeftCell
      .Top = rngZ.Top + (rngZ.Height - .Height) / 2
      .Left = rngZ.Left + (rngZ.Width - .Width) / 2
      .ShapeRange.LockAspectRatio = -1
      .Placement = xlMoveAndSize
      .PrintObject = True
    End With
    rngZ.Select
  End If
End Sub

So any ideas? Thx in advance

[nugol]

So, got it now.

Sub piccenter()
 Dim Row As Integer
 Dim Shp As Shape
 For Each Shp In ActiveSheet.Shapes
 Shp.Select
 
  Dim vSel As Variant
  Dim rngZ As Range
  Set vSel = Selection
  If VarType(vSel) = vbObject Then
    With vSel
      Set rngZ = .TopLeftCell
      .Top = rngZ.Top + (rngZ.Height - .Height) / 2
      .Left = rngZ.Left + (rngZ.Width - .Width) / 2
      .ShapeRange.LockAspectRatio = -1
      .Placement = xlMoveAndSize
      .PrintObject = True
    End With
    rngZ.Select
  End If
Next
End Sub