Dim sPicture, pic
Dim name
For a = 1 To Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If Worksheets(1).Cells(i, 1) <> "" Then
sPicture = Worksheets(1).Cells(i, 1)
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = Range("S6:AL27").Height
.Width = Range("S6:AL27").Width
.Top = Range("S6:AL27").Top
.Left = Range("S6:AL27").Left
.Placement = xlMoveAndSize
End With
name = Right(sPicture, InStr(1, StrReverse(sPicture), "\") - 1)
name = Left(name, Len(name) - 4)
pic.name = name
Set pic = Nothing
Next a