Sub ResizeImages()

' Define shape object variable
Dim sh As Shape

' Loop through all shapes in active worksheet
For Each sh In ActiveSheet.Shapes
    
    ' Resize and reposition images in specified cells
    If sh.TopLeftCell.Address = '$L$9' Or sh.TopLeftCell.Address = '$L$10' Or sh.TopLeftCell.Address = '$L$11' Or sh.TopLeftCell.Address = '$L$12' Or sh.TopLeftCell.Address = '$L$13' Or sh.TopLeftCell.Address = '$L$14' Or sh.TopLeftCell.Address = '$L$15' Or sh.TopLeftCell.Address = '$L$16' Then
        
        ' Resize shape to 87.874015748 pixels height and width
        sh.Height = 87.874015748
        sh.Width = 87.874015748
        
        ' Reposition shape to center of cell
        sh.Left = sh.TopLeftCell.Left + (sh.TopLeftCell.Width - sh.Width) / 2
        sh.Top = sh.TopLeftCell.Top + (sh.TopLeftCell.Height - sh.Height) / 2
        
        ' Allow shape to be resized without maintaining aspect ratio
        sh.LockAspectRatio = msoFalse
    
    End If
    
Next sh

' Ignore any errors that may occur during loop
On Error Resume Next

End Sub

VBA Code to Resize and Reposition Images in Excel Worksheet

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

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