Sub UnlockAspectRatioAndResizeShapes()

'Loop through all shapes on active sheet
For Each shp In ActiveSheet.Shapes

    'Unlock aspect ratio for all shapes
    shp.LockAspectRatio = msoFalse

    'Check if shape is located in cells L9 to L16
    If Intersect(shp.TopLeftCell, Range('L9:L16')) Is Nothing Then
        'Do nothing if shape is not in cells L9 to L16
    Else
        'Resize and reposition shape to center of cell with height and width of 87.874015748 pixels
        shp.Height = 87.874015748
        shp.Width = 87.874015748
        shp.Top = shp.TopLeftCell.Top + (shp.TopLeftCell.Height - shp.Height) / 2
        shp.Left = shp.TopLeftCell.Left + (shp.TopLeftCell.Width - shp.Width) / 2
    End If

Next shp

End Sub

VBA Code: Unlock Aspect Ratio and Resize Shapes in Excel

原文地址: https://www.cveoy.top/t/topic/mAGZ 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录