I have the following Macro which I use to insert pictures in Excel 2010 that worked fine but now I have converted the file to Excel 2013 and I am have 2 issues.

1) The macro seems that is not inserting the picture but the link to file, I need to insert the picture straight to the file.

2) The macro is looking in cells that have picture names & when there are not picture names in a cell its suppose to not insert anything, inserted it's inserting a default picture which is only to be inserted when there is a file name but no picture for it.

Appreciate any help, Thanks.


Sub add_pictures()

Const PictureHeight = 120

Folder = "o:\merchgrp\merch images\base images\"
FName = "No_Photo_Available.jpg"
DefaultPicture = Folder & FName

ActiveSheet.Unprotect Password:="12345"
Application.ScreenUpdating = False

'delete pictures
ActiveSheet.Pictures.Delete

LastCol = Cells(7, Columns.Count).End(xlToLeft).Row
Rows(18).RowHeight = PictureHeight

For Each cell In Range("B7:BCK7")
If cell < "" Then
cell.Offset(-6, 0).ClearContents
PictureFound = Dir(cell.Value)
Set Pict = Nothing '<= added
If PictureFound < "" Then

Set Pict = ActiveSheet.Pictures. _
Insert(cell.Value)
Else
On Error Resume Next '<=added
Set Pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
On Error GoTo 0 '<=added
End If
If Pict Is Nothing Then '<=added
MsgBox ("Could not add picture : " & cell.Value)
Else
Pict.ShapeRange.LockAspectRatio = msoTrue
Pict.ShapeRange.Height = PictureHeight
PictWidth = Pict.Width
CellWidth = Cells(18, cell.Column).Width
WidthBorder = CellWidth - PictWidth
Pict.Left = Cells(18, cell.Column).Left + (WidthBorder / -8)


PictHeight = Pict.Height
CellHeight = Cells(18, cell.Column).Height
HeightBorder = CellHeight - PictHeight
Pict.Top = Cells(18, cell.Column).Top + 4


If Pict.Width Pict.Height Then
If Pict.Width CellWidth Then
Crop = (Pict.Width - CellWidth) / 8
Pict.ShapeRange.PictureFormat.CropLeft = Crop
Pict.ShapeRange.PictureFormat.CropRight = Crop
End If

Else
If CellHeight Pict.Height Then
Crop = Abs(Pict.Height - CellHeight) / 2
Pict.ShapeRange.PictureFormat.CropTop = Crop
Pict.ShapeRange.PictureFormat.CropBottom = Crop
End If
End If
End If

End If 'new line
Next cell

Range("18:18,25:25,32:32,39:39").Select
Range("A39").Activate
Selection.RowHeight = 126
Range("A17").Select

Range("19:24,26:31,33:38,40:45").Select
Range("A45").Activate
Selection.RowHeight = 15
Range("A17").Select

Range("20:20,27:27,34:34,41:41").Select
Range("A41").Activate
Selection.RowHeight = 16
Range("A17").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:="12345"

Exit Sub 'new line
End Sub