VBA Excel automatic image resize & border - excel

Question

I would like to have my image properly resized and bordered with the black line, thickness 1.
My situation looks like this:
and when I used this code:
Sub ResizeCivilsA()
SizeToRange Sheets("Civils 1").Pictures("Picture 29"), Range("B3:L46")
End Sub
Function SizeToRange(s, Target As Range)
s.Left = Target.Left + 10
s.Top = Target.Top - 5
s.Width = Target.Width
s.Height = Target.Height
End Function
, everything was adjusted fine, but:
It have been done only for the specified shape id, which is "Picture 29"
It was without the borders
So I tried then:
Sub ResizeCivilsA()
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets
If shp.Name Like "*Picture*" Then
SizeToRange shp, Range("B3:L46")
End If
Next
and finally I am getting error:
Type mismatch, with debugger pointing the line:
For Each shp In ThisWorkbook.Worksheets
Regarding the border around the image I found the common solution here:
https://learn.microsoft.com/en-us/office/vba/api/Excel.Range.BorderAround
However after appliance into my work:
Worksheets("Civils 1").Shape("Picture 29").BorderAround _
ColorIndex:=3, Weight:=xlThick
it wasn't enough since I had to remove the _ and got nothing afterward.
Is there some way to have the possibility for instant resizing the image and making the border around it for ANY attached image, which as default is called "Picture..."?

Answer 1

Try this code.
Read code's comments and adjust it to fit your needs
EDIT: The code checks if picture is within target range ad then adjusts its properties.
Code:
Option Explicit
Public Sub ResizeAllShapesInSheet()
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetShape As Shape
' Define the sheet that has the pictures
Set targetSheet = ThisWorkbook.Worksheets("Civils 1")
' Define the range the images is going to fit
Set targetRange = targetSheet.Range("B3:L46")
' Loop through each Shape in Sheet
For Each targetShape In targetSheet.Shapes
' Check "picture" word in name
If targetShape.Name Like "*Picture*" Then
' Call the resize function
SizeToRange targetShape, targetRange
End If
Next targetShape
End Sub
Private Sub SizeToRange(ByVal targetShape As Shape, ByVal Target As Range)
If Not (targetShape.Left >= Target.Left And _
targetShape.Top >= Target.Top And _
targetShape.Left + targetShape.Width <= Target.Left + Target.Width And _
targetShape.Top + targetShape.Height <= Target.Top + Target.Height) Then Exit Sub
' Adjust picture properties
With targetShape
' Check if next line is required...
.LockAspectRatio = msoFalse
.Left = Target.Left + 10
.Top = Target.Top - 5
.Width = Target.Width
.Height = Target.Height
End With
' Adjust picture border properties
With targetShape.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Visible = msoTrue
.Weight = 6
End With
End Sub
Let me know if it works

Answer 2

Initial read looks like your For Each is looking for Shape objects, but you are giving it a collection of Sheet objects.
For Each sht In ThisWorkbook.Worksheets
For Each shp In sht.Shapes
If shp.Name Like "*Picture*" Then
Set r1 = shp.TopLeftCell
Set r2 = r1.Offset(10, 43)
SizeToRange shp, Range(r1.Address & ":" & r2.Address)
End If
Next shp
Next sht
Hope that helps!
EDIT: Updated with relative address.