VBA Code: Center and Resize Shapes in Excel Cells L9 to L16
This VBA code loops through all the shapes on the active sheet and unlocks their aspect ratio. It then checks if the shape is located in any of the cells L9 to L16 and resizes and repositions it to the center of the cell with a height and width of 87.874015748 pixels. If the shape is not in any of these cells, it remains unchanged.
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
原文地址: https://www.cveoy.top/t/topic/mAFC 著作权归作者所有。请勿转载和采集!