VBA Macro: Center and Resize Shapes in Specific Cells (L9 to L16)
This macro loops through all shapes on the active sheet and sets their lock aspect ratio property to 'false'. Then, it checks if the shape is located in any of the cells L9 to L16 and resizes and repositions it to fit in the middle of the cell with a width and height of 87.874015748 points (approximately 1.22 inches).
Sub nnn()
Dim sh As Shape
On Error Resume Next
For Each sh In ActiveSheet.Shapes
sh.LockAspectRatio = msoFalse
If sh.TopLeftCell.Address = "$L$9" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$10" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$11" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$12" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$13" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$14" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$15" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
ElseIf sh.TopLeftCell.Address = "$L$16" Then
sh.Height = 87.874015748
sh.Width = 87.874015748
sh.Left = (sh.TopLeftCell.Width - sh.Width) / 2 + sh.TopLeftCell.Left '定义图片位置于所在单元格中间位置
sh.Top = (sh.TopLeftCell.Height - sh.Height) / 2 + sh.TopLeftCell.Top '定义图片位置于所在单元格中间位置
End If
Next
End Sub
This code snippet can be easily adapted to work with other cell ranges and shape sizes based on your specific requirements.
原文地址: http://www.cveoy.top/t/topic/mAwQ 著作权归作者所有。请勿转载和采集!