VBA: Lock Aspect Ratio and Resize Shapes in Excel
Sub LockAspectRatioAndResize() Dim s As Shape
'Lock aspect ratio of all shapes on active sheet
For Each s In ActiveSheet.Shapes
s.LockAspectRatio = msoTrue
Next s
'Resize and center specific shapes
With ActiveSheet.Shapes('Shape1')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L9').Top + (Range('L9').Height - .Height) / 2
.Left = Range('L9').Left + (Range('L9').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape2')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L10').Top + (Range('L10').Height - .Height) / 2
.Left = Range('L10').Left + (Range('L10').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape3')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L11').Top + (Range('L11').Height - .Height) / 2
.Left = Range('L11').Left + (Range('L11').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape4')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L12').Top + (Range('L12').Height - .Height) / 2
.Left = Range('L12').Left + (Range('L12').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape5')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L13').Top + (Range('L13').Height - .Height) / 2
.Left = Range('L13').Left + (Range('L13').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape6')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L14').Top + (Range('L14').Height - .Height) / 2
.Left = Range('L14').Left + (Range('L14').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape7')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L15').Top + (Range('L15').Height - .Height) / 2
.Left = Range('L15').Left + (Range('L15').Width - .Width) / 2
End With
With ActiveSheet.Shapes('Shape8')
.Height = 87.874015748
.Width = 87.874015748
.Top = Range('L16').Top + (Range('L16').Height - .Height) / 2
.Left = Range('L16').Left + (Range('L16').Width - .Width) / 2
End With
End Sub
原文地址: http://www.cveoy.top/t/topic/mAwH 著作权归作者所有。请勿转载和采集!