VBA Macro: Centering Shapes in Specific Cells

This macro iterates through all the shapes in the active worksheet and adjusts their aspect ratio to be unlocked. It then checks the address of each shape's top left cell and adjusts its height, width, left, and top properties accordingly to center it in the cell. The code is specific to a group of cells in the worksheet, but it can be modified to work with any desired set of cells.

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

How to Modify the Code:

1. Change Cell Addresses: Modify the If statements to include the desired cell addresses where you want to center shapes.
2. Adjust Height and Width: Modify the sh.Height and sh.Width lines to set the desired dimensions for the shapes.

By adjusting these parameters, you can use this macro to center shapes within any specific range of cells in your Excel worksheet.