Insert Pictures using Macros

[marc747]

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

 

[Joel]

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

 

[marc747]

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














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

 

[Joel]

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

 

[marc747]

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






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

 

[Joel]

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

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

















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

 

[marc747]

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

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.

 

[Joel]

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

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

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

:
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

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

 

[marc747]

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

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
:
Picturesare not part of the worksheet cell structure but instead apicture
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 widthof 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 ofthe cell
and the width porperty of the picture to get the picture to appearlike 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
:
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
:
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 appreciatefor 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.

 

[Joel]

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

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

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

:
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

:
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

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

 

[marc747]

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





...

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

 

[Joel]

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

 

[marc747]

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





...

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.

 

[Joel]

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

 

[marc747]

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





...

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

 

[Joel]

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.

 

[marc747]

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





...

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