Excel VBA批量调整图片大小及添加边框报错求助

Hey there, let's fix that error first and get your multiple pictures resized and bordered properly!

The Wrong number of arguments or invalid property assignment error you're seeing is straightforward: your SizeToRange subroutine is defined to accept only 2 parameters (the shape and a single target range), but you're passing 3 parameters when you call it (targetShape, targetRange1, targetRange2). VBA can't handle that mismatch, hence the error.

Now, let's adjust the code to fit your need of processing multiple images. I'll cover two common scenarios you might be aiming for:

Scenario 1: All pictures match a single target range #

If you want every picture to resize and align to the same range (e.g., B3:L24), just tweak the call to pass only one range parameter:

Public Sub ResizeCab()
    Dim targetSheet As Worksheet
    Dim targetRange As Range
    Dim targetShape As Shape
    
    Set targetSheet = ThisWorkbook.ActiveSheet
    Set targetRange = targetSheet.Range("B3:L24") ' Use this single range for all pics
    
    For Each targetShape In targetSheet.Shapes
        If targetShape.Name Like "*Picture*" Then
            SizeToRange targetShape, targetRange ' Pass only one range here
        End If
    Next targetShape
End Sub

Private Sub SizeToRange(ByVal targetShape As Shape, ByVal Target As Range)
    With targetShape
        .LockAspectRatio = msoFalse
        .Left = Target.Left + 10
        .Top = Target.Top - 5
        .Width = Target.Width
        .Height = Target.Height
        .ZOrder msoSendToBack
    End With
    With targetShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .TintAndShade = 0
        .Brightness = 0
        .Transparency = 0
        .Weight = 1
    End With
End Sub

Scenario 2: Alternate pictures between two target ranges #

If you want to split pictures between B3:L24 and B25:L46 (e.g., 1st pic in first range, 2nd in second, 3rd back to first, etc.), add a counter to handle the alternation:

Public Sub ResizeCab()
    Dim targetSheet As Worksheet
    Dim targetRange1 As Range, targetRange2 As Range
    Dim targetShape As Shape
    Dim picCounter As Integer ' Counter to alternate between ranges
    
    Set targetSheet = ThisWorkbook.ActiveSheet
    Set targetRange1 = targetSheet.Range("B3:L24")
    Set targetRange2 = targetSheet.Range("B25:L46")
    picCounter = 0 ' Initialize counter
    
    For Each targetShape In targetSheet.Shapes
        If targetShape.Name Like "*Picture*" Then
            picCounter = picCounter + 1
            ' Assign range based on even/odd counter value
            If picCounter Mod 2 = 1 Then
                SizeToRange targetShape, targetRange1
            Else
                SizeToRange targetShape, targetRange2
            End If
        End If
    Next targetShape
End Sub

Private Sub SizeToRange(ByVal targetShape As Shape, ByVal Target As Range)
    With targetShape
        .LockAspectRatio = msoFalse
        .Left = Target.Left + 10
        .Top = Target.Top - 5
        .Width = Target.Width
        .Height = Target.Height
        .ZOrder msoSendToBack
    End With
    With targetShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .TintAndShade = 0
        .Brightness = 0
        .Transparency = 0
        .Weight = 1
    End With
End Sub

Quick Notes #

• Both solutions will batch-process all pictures matching the *Picture* name pattern, automatically resizing, positioning, adding a 1pt black border, and sending them to the back.
• If you have a different logic for assigning pictures to ranges (e.g., based on their original position), just add a custom condition inside the If targetShape.Name Like "*Picture*" block to pick the right range.

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