Excel VBA Macro: Center Shapes in Cells and Adjust Aspect Ratio

Sub AdjustShapesAspectRatio()

Dim shp As Shape Dim cell As Range

For Each shp In ActiveSheet.Shapes shp.LockAspectRatio = msoFalse 'Unlock aspect ratio Set cell = shp.TopLeftCell 'Get top left cell of shape If Not cell Is Nothing Then 'If shape is within a cell With cell.MergeArea 'Get merged cell range shp.Height = .Height 'Adjust height to match cell shp.Width = .Width 'Adjust width to match cell shp.Left = .Left 'Center horizontally in cell shp.Top = .Top 'Center vertically in cell End With End If Next shp

End Sub