the code look ok. here are some ideas

1) The DefaultPicture = "C:\temp\MyPicture.jpg" file doesn't exist.
2) Check the value of LastCol

LastCol = Cells(4, Columns.Count).End(xltoleft).Row
msgbox (LastCol) '<= Add

3) The pictures you selected don't display anything

4) The column widths are too narrow to see the pciture.

5) You are getting an error. Try adding this line to see if yo uare exiting
the For loop before you reach the last column

msgbox(cell.address) '<= add just before the Next cell statement
Next cell


" wrote:

On Jun 16, 3:19 am, Joel wrote:
Row 5 is being cleared by the following statement

1) cell.Offset(1, 0).ClearContents

Because cell is every cell in the Range B4:Iv4 the abovestatement is
clearing the cell one row greater than row 4.

2) This statment is doing nothing. Iorigianally put it in the code because
I thought you cells that contained thepicturenames were going down the rows
instead of across the columns.

LastRow = Cells(Rows.Count, "D").End(xlUp).Row

Rows.Count is a constant in excel which indicated the lastrow of the
worksheet (65,536). To find the last used cell in Column D the code starts
at D65536 and looks up the column (end(xlup) until it finds data.

You could make this change in your code to find the last column in a similar
fashion.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "C:\temp\MyPicture.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastCol = Cells(4, Columns.Count).End(xltoleft).Row
Rows(5).RowHeight = PictureHeight

For Each cell In Range(Range("B4"),Cells(4,LastCol))
If cell < "" Then
cell.Offset(1, 0).ClearContents
PictureFound = Dir(cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
PictWidth = pict.Width
CellWidth = Cells(9, cell.Column).Width
WidthBorder = CellWidth - PictWidth
pict.Left = Cells(9, cell.Column).Left + (WidthBorder / 2)

PictHeight = pict.Height
CellHeight = Cells(9, cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, cell.Column).Top + (HeightBorder / 2)
End If 'new line
Next cell
Exit Sub 'new line

End Sub



" wrote:
On Jun 15, 6:56 pm, Joel wrote:
You have to subtract the size of thepicturefrom the size of the cell and
shift thepictureby 1/2 the difference. You dod this using the height and
width properties as shown below.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "C:\temp\MyPicture.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Rows(5).RowHeight = PictureHeight

For Each cell In Range("B4:IV4")
If cell < "" Then
cell.Offset(1, 0).ClearContents
PictureFound = Dir(cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
PictWidth = pict.Width
CellWidth = Cells(9, cell.Column).Width
WidthBorder = CellWidth - PictWidth
pict.Left = Cells(9, cell.Column).Left + (WidthBorder / 2)

PictHeight = pict.Height
CellHeight = Cells(9, cell.Column).Height
HeightBorder = CellHeight - PictHeight
pict.Top = Cells(9, cell.Column).Top + (HeightBorder / 2)
End If 'new line
Next cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 15, 5:23 pm, Joel wrote:
It should of been
cells(9,cell.column) = "Picturenot Available"

You can replace this line with ainsertof a standardpicturelike yoiu did
in the other part of the code.

Sub add_pictures()

Const PictureHeight = 120
DefaultPicture = "C:\temp\MyPicture.jpg"

Application.ScreenUpdating = False

'delete pictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Rows(5).RowHeight = PictureHeight

For Each cell In Range("B4:IV4")
If cell < "" Then
cell.Offset(1, 0).ClearContents
PictureFound = Dir(cell.Value)
If PictureFound < "" Then

Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
Else
Set pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
End If
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = Cells(9, cell.Column).Top
pict.Left = Cells(9, cell.Column).Left
End If 'new line
Next cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 15, 4:25 am, Joel wrote:
Picturesare not part of the worksheet cell structure but instead apicture
is an object tjat sits ontop of the worksheet. You can put apictureontop
of a cell by using the Top and Left properties. Top and Left are pixel
locations on the screen and changes when you change the height of a row or
Width of a column. the pciture will not move when the Row height is changed
or the column width is changed so thepicturewill look like it moved when
height/width are adjusted.

Use DIR to find if apictureexists before you inset thepictureon the
worksheet. The code below will work as long as the formaty (ie jpg) of the
pictureis recognized on your PC. You have to adjust the width of the
Columns on the worksheet to the right size before you add thepicture.
Another choise is to add thepictureand use the width porperty of the cell
and the width porperty of thepictureto get thepictureto appear like they
are the same width as the column. You can either make the all the columns
the same width and scale thepictureto fit the column width, or scale the
Columns width to fit thepicturewidth.

Sub add_pictures()

Const PictureHeight = 120

Application.ScreenUpdating = False

'deletepictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Rows(5).RowHeight = PictureHeight

For Each cell In Range("B4:IV4")
If cell < "" Then
cell.Offset(1, 0).ClearContents
PictureFound = dir(cell.Value)
if PictureFound < "" then

Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cells(9,cell.column).Top
pict.Left = cells(9,cell.column).Left
else
cell(1,0) = "Picturenot Available"
End If
End If 'new line
Next cell
Exit Sub 'new line

End Sub

" wrote:
On Jun 14, 7:28 pm, Joel wrote:
From
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
to
pict.Top = Range("B9").Top
pict.Left = Range("B9").Left

" wrote:
Hi I have a Marco that insertspicturesin excel, I need to make a few
changes but I am having difficulty.
This macro is looking into a cell that has thepicturefile location
and it is inserting thepictureright below that cell. But what I need
to change is, I need to be able toinsertthepictureto different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthepicturein cell "B9")

Below is the macro that I use. I would greatly appreciate for your
help, Thank You.

Sub add_pictures()

Const PictureHeight = 120

Application.ScreenUpdating = False

'deletepictures
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Rows(5).RowHeight = PictureHeight

For Each cell In Range("B4:IV4")
If cell < "" Then
cell.Offset(1, 0).ClearContents
On Error GoTo NoPict 'new line
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
If cell.Offset(1, 0).Value < "Picturenot Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top

...

read more »- Hide quoted text -

- Show quoted text -

Hi, Thanks.
Everything works but I came across another problem. when I run the
Macro it is placing the pictures in ROW 9 under each column from B9 to
FA9 Its should go all the way from B9 to IV9 because my range is B4 to
IV4 and I have data in each cell from B4 to IV4 but for some reason it
is stopping at cell FA9 and then it is placing the rest of the
pictures in between Cell FA9 and FB9 on top of one another.
Thanks for your help I greatly appreciate it. I hope we can fix this
one.....