Insert Pictures using Macros
 

Hi I have a Marco that inserts pictures in excel, I need to make a few
changes but I am having difficulty.
This macro is looking into a cell that has the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able to insert the picture to different
cell (example: the cell that has the location on the file is "B4" and
I want to insert the picture in 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

'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
On Error GoTo NoPict 'new line
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
If cell.Offset(1, 0).Value < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line


NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line


End Sub

Insert Pictures using Macros
 

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 inserts pictures in excel, I need to make a few
changes but I am having difficulty.
This macro is looking into a cell that has the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able to insert the picture to different
cell (example: the cell that has the location on the file is "B4" and
I want to insert the picture in 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

'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
On Error GoTo NoPict 'new line
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
If cell.Offset(1, 0).Value < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line


NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line


End Sub

Insert Pictures using Macros
 

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 inserts pictures in excel, I need to make a few
changes but I am having difficulty.
This macro is looking into a cell that has the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able to insert the picture to different
cell (example: the cell that has the location on the file is "B4" and
I want to insert the picture in 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

'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
* *On Error GoTo NoPict 'new line
* * * Set pict = ActiveSheet.Pictures. _
* * * * *Insert(cell.Value)
* * * * *If cell.Offset(1, 0).Value < "Picture not Available" Then
'new line
* * * pict.ShapeRange.LockAspectRatio = msoTrue
* * * pict.ShapeRange.Height = PictureHeight
* * * pict.Top = cell.Offset(1, 0).Top
* * * pict.Left = cell.Offset(1, 0).Left
* *End If
* * * * End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and the pictures
should be inserted from "B9:AA9" and if a picture is not available it
should insert the text "Picture not Available" with the addition of
you text it insets all the pictures in cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.

Insert Pictures using Macros
 

Pictures are not part of the worksheet cell structure but instead a picture
is an object tjat sits ontop of the worksheet. You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

Sub add_pictures()


Const PictureHeight = 120

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)
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) = "Picture not 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 inserts pictures in excel, I need to make a few
changes but I am having difficulty.
This macro is looking into a cell that has the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able to insert the picture to different
cell (example: the cell that has the location on the file is "B4" and
I want to insert the picture in 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

'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
On Error GoTo NoPict 'new line
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
If cell.Offset(1, 0).Value < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and the pictures
should be inserted from "B9:AA9" and if a picture is not available it
should insert the text "Picture not Available" with the addition of
you text it insets all the pictures in cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.

Insert Pictures using Macros
 

On Jun 15, 4:25*am, Joel wrote:
Picturesare not part of the worksheet cell structure but instead a picture
is an object tjat sits ontop of the worksheet. *You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
* * * pict.ShapeRange.LockAspectRatio = msoTrue
* * * pict.ShapeRange.Height = PictureHeight
* * * pict.Top = cell.Offset(1, 0).Top
* * * pict.Left = cell.Offset(1, 0).Left
* *End If
* * * * End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -



Hi,
Thanks It works but I had to change the [cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!

Insert Pictures using Macros
 

It should of been
cells(9,cell.column) = "Picture not Available"


You can replace this line with a insert of a standard picture like 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 a picture
is an object tjat sits ontop of the worksheet. You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -



Hi,
Thanks It works but I had to change the [cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!

Insert Pictures using Macros
 

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

You can replace this line with a insert of a standard picture like 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 a picture
is an object tjat sits ontop of the worksheet. *You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
* * * pict.ShapeRange.LockAspectRatio = msoTrue
* * * pict.ShapeRange.Height = PictureHeight
* * * pict.Top = cell.Offset(1, 0).Top
* * * pict.Left = cell.Offset(1, 0).Left
* *End If
* * * * End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -

Hi,
Thanks It works but I had to change the *[cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!- Hide quoted text -

- Show quoted text -

Hi,
Thank you very much.
Just one more question I forgot to ask, how can I center the picture,
right now it places the picture in the TOP LEFT corner, how can I
place it at Horizontal:Center, Vertical:Center.
Thanks.

Insert Pictures using Macros
 

You have to subtract the size of the picture from the size of the cell and
shift the picture by 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) = "Picture not Available"

You can replace this line with a insert of a standard picture like 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 a picture
is an object tjat sits ontop of the worksheet. You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -

Hi,
Thanks It works but I had to change the [cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!- Hide quoted text -

- Show quoted text -

Hi,
Thank you very much.
Just one more question I forgot to ask, how can I center the picture,
right now it places the picture in the TOP LEFT corner, how can I
place it at Horizontal:Center, Vertical:Center.
Thanks.

Insert Pictures using Macros
 

On Jun 15, 6:56*pm, Joel wrote:
You have to subtract the size of the picture from the size of the cell and
shift the picture by 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) = "Picture not Available"

You can replace this line with a insert of a standard picture like 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 a picture
is an object tjat sits ontop of the worksheet. *You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
* * * pict.ShapeRange.LockAspectRatio = msoTrue
* * * pict.ShapeRange.Height = PictureHeight
* * * pict.Top = cell.Offset(1, 0).Top
* * * pict.Left = cell.Offset(1, 0).Left
* *End If
* * * * End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -

Hi,
Thanks It works but I had to change the *[cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!- Hide quoted text -

- Show quoted text -

Hi,
Thank you very much.
Just one more question I forgot to ask, how can I center the picture,
right now it places the picture in the TOP LEFT corner, how can I
place it at Horizontal:Center, Vertical:Center.
Thanks.- Hide quoted text -

- Show quoted text -


Hi,
Thanks, Can you tell me, what is the line [LastRow = Cells(Rows.Count,
"D").End(xlUp).Row] for or mean.
I have changed the [Rows(5).RowHeight = PictureHeight] to
[Rows(9).RowHeight = PictureHeight]
Everything works fine except when I run the Macro ROW 5 is being
Deleted.

Thank You.

Insert Pictures using Macros
 

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 the picture names 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 the picture from the size of the cell and
shift the picture by 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) = "Picture not Available"

You can replace this line with a insert of a standard picture like 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 a picture
is an object tjat sits ontop of the worksheet. You can put a picture ontop
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 the picture will look like it moved when
height/width are adjusted.

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

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) = "Picture not 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 the picture file location
and it is inserting the picture right below that cell. But what I need
to change is, I need to be able toinsertthe picture to different
cell (example: the cell that has the location on the file is "B4" and
I want toinsertthe picture in 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 < "Picture not Available" Then
'new line
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
End If 'new line
Next cell
Exit Sub 'new line

NoPict: cell.Offset(1, 0).Value = "Picture not Available" 'new line
Resume Next 'new line

End Sub- Hide quoted text -

- Show quoted text -

Thanks, but I am still having some difficulty, I used you line and yes
the picture was inserted in the right Cell but it is not only one
picture, the picture address starts from "B4: AA4" and thepictures
should be inserted from "B9:AA9" and if a picture is not available it
shouldinsertthe text "Picture not Available" with the addition of
you text it insets all thepicturesin cell "B9" one on top of each
other. and the text "Picture not Available" gets inserted in cell
"B5"
I thank you in advance I hope you can help.- Hide quoted text -

- Show quoted text -

Hi,
Thanks It works but I had to change the [cell(1,0) = "Picture not
Available"] to [cell(7,1) = "Picture not Available"] in order for the
"Picture not Available" text be in the same ROW as the pictures,
questions is, IS THIS CORRECT?
also is it possible that if it can not find the picture instead of
inserting the text "Picture not Available" can it insert a default
Picture file example ["C:\My Pictures\Picture_not_Available.jpg"]
Thank you very much!- Hide quoted text -

- Show quoted text -

Hi,
Thank you very much.
Just one more question I forgot to ask, how can I center the picture,
right now it places the picture in the TOP LEFT corner, how can I
place it at Horizontal:Center, Vertical:Center.
Thanks.- Hide quoted text -

- Show quoted text -


Hi,
Thanks, Can you tell me, what is the line [LastRow = Cells(Rows.Count,
"D").End(xlUp).Row] for or mean.
I have changed the [Rows(5).RowHeight = PictureHeight] to
[Rows(9).RowHeight = PictureHeight]
Everything works fine except when I run the Macro ROW 5 is being
Deleted.

Thank You.

Insert Pictures using Macros
 

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.....

Insert Pictures using Macros
 

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.....

Insert Pictures using Macros
 

On Jun 17, 3:48*am, Joel wrote:
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

...

read more »- Hide quoted text -

- Show quoted text -

Hi,
The DefaultPicture, - this file is there and it is using it in some
cells before the cell FA9
When I run the Marco it seems that it is displying all the pictures it
just after cell FA9 it starts to display one picture on to of the
other right in between FA9 and FB9.
The Column widths are all the same.
also when I the run Marco it runs without dislaying any errer.
I am sorry I did not understand where to add the "msgbox(cell.address)
"
thanks.

Insert Pictures using Macros
 

the msgbox was to go on the line just before the Next Cell statement. Since
yo usaid that all the pictures were ontop of each other I think it is better
to try this test code

The code will put in row 100 all the pixel values of the left edge of the
cell. I think there may be a problem with the pixel number. Change the row
number to an unesed Row so it doesn't over-write any data.

For Colcount = 1 To 256
Cells(100, Colcount).Value = Cells(100, Colcount).Left
Next Colcount

" wrote:

On Jun 17, 3:48 am, Joel wrote:
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

...

read more »- Hide quoted text -

- Show quoted text -

Hi,
The DefaultPicture, - this file is there and it is using it in some
cells before the cell FA9
When I run the Marco it seems that it is displying all the pictures it
just after cell FA9 it starts to display one picture on to of the
other right in between FA9 and FB9.
The Column widths are all the same.
also when I the run Marco it runs without dislaying any errer.
I am sorry I did not understand where to add the "msgbox(cell.address)
"
thanks.

Insert Pictures using Macros
 

On Jun 17, 7:18*am, Joel wrote:
the msgbox was to go on the line just before the Next Cell statement. *Since
yo usaid that all the pictures were ontop of each other I think it is better
to try this test code

The code will put in row 100 all the pixel values of the left edge of the
cell. *I think there may be a problem with the pixel number. *Change the row
number to an unesed Row so it doesn't over-write any data.

For Colcount = 1 To 256
* *Cells(100, Colcount).Value = Cells(100, Colcount).Left
Next Colcount



" wrote:
On Jun 17, 3:48 am, Joel wrote:
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

...

read more »- Hide quoted text -

- Show quoted text -



Hi,
I added the line that you suggested and in Row 100 I got some
numbers,
(Cell A100 it says "0")
(Cell B100 "99.75") then ("257.25") and so on,
in cell (FA100 "24512.25") (FB100 "24575.25") and after that (FC100
"24575.25") same as FB100, and the same number all the way to the last
cell (IV100 "24575.25")

Thanks

Insert Pictures using Macros
 

You got the results I was expecting. It looks like the maximum Pixel Value
is approximately 25,000. I check the Worksheet help under "Specifications
and Limits" and did not find this limit listed. Th eonly way of solving this
problem is to make the column widths narrower approximately 25,000/256
columns (column IV is 255) so that all the pictures will fit.

the pictures are being placed using the left pixel number which is the
number being displayed in row 100.

" wrote:

On Jun 17, 7:18 am, Joel wrote:
the msgbox was to go on the line just before the Next Cell statement. Since
yo usaid that all the pictures were ontop of each other I think it is better
to try this test code

The code will put in row 100 all the pixel values of the left edge of the
cell. I think there may be a problem with the pixel number. Change the row
number to an unesed Row so it doesn't over-write any data.

For Colcount = 1 To 256
Cells(100, Colcount).Value = Cells(100, Colcount).Left
Next Colcount



" wrote:
On Jun 17, 3:48 am, Joel wrote:
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

...

read more »- Hide quoted text -

- Show quoted text -



Hi,
I added the line that you suggested and in Row 100 I got some
numbers,
(Cell A100 it says "0")
(Cell B100 "99.75") then ("257.25") and so on,
in cell (FA100 "24512.25") (FB100 "24575.25") and after that (FC100
"24575.25") same as FB100, and the same number all the way to the last
cell (IV100 "24575.25")

Thanks

Insert Pictures using Macros
 

On Jun 17, 9:48*am, Joel wrote:
You got the results I was expecting. *It looks like the maximum Pixel Value
is approximately 25,000. *I check the Worksheet help under "Specifications
and Limits" and did not find this limit listed. *Th eonly way of solving this
problem is to make the column widths narrower approximately 25,000/256
columns *(column IV is 255) so that all the pictures will fit.

the pictures are being placed using the left pixel number which is the
number being displayed in row 100.



" wrote:
On Jun 17, 7:18 am, Joel wrote:
the msgbox was to go on the line just before the Next Cell statement. *Since
yo usaid that all the pictures were ontop of each other I think it is better
to try this test code

The code will put in row 100 all the pixel values of the left edge of the
cell. *I think there may be a problem with the pixel number. *Change the row
number to an unesed Row so it doesn't over-write any data.

For Colcount = 1 To 256
* *Cells(100, Colcount).Value = Cells(100, Colcount).Left
Next Colcount

" wrote:
On Jun 17, 3:48 am, Joel wrote:
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

...

read more »- Hide quoted text -

- Show quoted text -


Hi,
You are right, the smaller I make the column width the more pictures I
get correctly placed in the cells.
But does the picture size "bytes" affect this, meaning if I use
smaller pictures will this affect or no, if my pictures are 7kb or
200k each will this have the same affect, or the pixel has to do the
way excel works.
I need one more thing, I realized that not all my pictures are the
same hight and weight, can we enter somthing in macro that will make
the picture not go over say height of 120 and a width of 150

Thanks

Cannot Read the posts above?
 

Hi,
What happen so the formatting of the posts have been ruined?

I cannot even tell if there has been a solution to inserting pictures from a separate cell, and if scaling pictures is another option?

If so, would it be possible to repost the script in its entirety?

Thanks,
-J