如何修改VBA代码实现E列E5起单元格内图片批量居中？

Great question! Your existing CenterMe subroutine already has the core logic to center a shape over a cell—we just need to expand it to loop through all 30 images and their matching cells. Here are two reliable approaches to get this done:

Approach 1: Robust (Matches Shapes to Their Cells) #

This method finds the exact shape inside each target cell, even if shapes aren't in sequential order. It’s perfect if you’re not sure the shape numbering aligns with the cell order:

Sub CenterAllImages()
    Dim targetCell As Range
    Dim shp As Shape
    Dim ws As Worksheet
    
    ' Set your worksheet (replace "Sheet1" with your actual sheet name if needed)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Loop through E5 to E34 (30 cells total starting at E5)
    For Each targetCell In ws.Range("E5:E34")
        ' Find the shape located in this target cell
        For Each shp In ws.Shapes
            ' Check if the shape's top-left corner is inside the target cell
            If shp.TopLeftCell.Address = targetCell.Address Then
                ' Use your existing CenterMe logic to center the shape
                CenterMe shp, targetCell
                Exit For ' Exit inner loop once we find the matching shape
            End If
        Next shp
    Next targetCell
End Sub

Sub CenterMe(Shp As Shape, OverCells As Range)
    With OverCells
        Shp.Left = .Left + ((.Width - Shp.Width) / 2)
        Shp.Top = .Top + ((.Height - Shp.Height) / 2)
    End With
End Sub

Approach 2: Efficient (Sequential Shapes) #

If you know your shapes are numbered in order (e.g., Shapes(1) is in E5, Shapes(2) in E6, ..., Shapes(30) in E34), this faster method skips the shape lookup:

Sub CenterAllImages_Sequential()
    Dim i As Integer
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Loop through 1 to 30 shapes, matching to E5 through E34
    For i = 1 To 30
        CenterMe ws.Shapes(i), ws.Range("E5").Offset(i - 1, 0)
    Next i
End Sub

' Keep your existing CenterMe subroutine unchanged
Sub CenterMe(Shp As Shape, OverCells As Range)
    With OverCells
        Shp.Left = .Left + ((.Width - Shp.Width) / 2)
        Shp.Top = .Top + ((.Height - Shp.Height) / 2)
    End With
End Sub

Key Notes: #

• Worksheet Reference: Replace "Sheet1" with your actual worksheet name to avoid relying on ActiveSheet (which can cause errors if the wrong sheet is selected).
• Shape Matching: The first approach uses TopLeftCell to link shapes to cells. If your images are positioned such that their top-left corner isn’t in the target cell, you could adjust the check to verify if the shape’s center falls within the cell instead.
• Single Shape per Cell: Both methods assume one shape per cell. If a cell has multiple shapes, the first approach will only center the one with its top-left corner in the cell.

内容的提问来源于stack exchange，提问作者Baber Beg