Inserting Pictures Based On File name

[Jeff W.]

I have this code from another thread posted by Joel, and I want
to find out if it will work for me

On my sheet I have a file name in column A and this is the name of
the file I want to insert automatically into that cell or on top of that
cell.

The number of rows changes from sheet to sheet, and to allow room
for the picture, the rows may be, the first three, then the next three then
the next three

So my sheet may look like this;

ball.bmp | 1 | "need image inserted into cell A1"
|.750 |
| 3.0 |
bull.bmp | 1 | "need image inserted into cell A4"
|.500 |
| 3.5 |
squ .bmp | 1 | "need image inserted into cell A7"
|.375 |
| 3.2 |

etc, etc as long as the sheet might be...

I think, I would be checking every fourth row for a file name

Would this code work or would I be better of using something else?

Thanks

Jeff W.

.......................................................................................................................
The code deletes all old pictures and then adds all the pictures. It is not
easy to only delete the pictures that have changed.

Sub add_pictures()

Const PictureHeight = 25

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

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows(2).RowHeight = PictureHeight

For Each cell In Range("B1:K1")
If cell <> "" Then
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
Next cell

End Sub

.......................................................................................................................

 

[Corey]

Not sure if will assist or hinder, but i use the following code to input a picture into a sheet
based on Cell(A1):

' Photo 1
Application.ScreenUpdating = False
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim mypic As Picture
Dim res As Variant
Set WB = ActiveWorkbook
res = sheet1.Range("A1").value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
End With
End If

Corey....

I have this code from another thread posted by Joel, and I want
to find out if it will work for me

On my sheet I have a file name in column A and this is the name of
the file I want to insert automatically into that cell or on top of that
cell.

The number of rows changes from sheet to sheet, and to allow room
for the picture, the rows may be, the first three, then the next three then
the next three

So my sheet may look like this;

ball.bmp | 1 | "need image inserted into cell A1"
|.750 |
| 3.0 |
bull.bmp | 1 | "need image inserted into cell A4"
|.500 |
| 3.5 |
squ .bmp | 1 | "need image inserted into cell A7"
|.375 |
| 3.2 |

etc, etc as long as the sheet might be...

I think, I would be checking every fourth row for a file name

Would this code work or would I be better of using something else?

Thanks

Jeff W.

.......................................................................................................................
The code deletes all old pictures and then adds all the pictures. It is not
easy to only delete the pictures that have changed.

Sub add_pictures()

Const PictureHeight = 25

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

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows(2).RowHeight = PictureHeight

For Each cell In Range("B1:K1")
If cell <> "" Then
Set pict = ActiveSheet.Pictures. _
Insert(cell.Value)
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = cell.Offset(1, 0).Top
pict.Left = cell.Offset(1, 0).Left
End If
Next cell

End Sub

.......................................................................................................................

 

[Jeff W.]

Thank you for the responce Cory, although I do have a concern or two.

I have my image files in a sub folder of the workbook folder, for example

c:\setup This is where the wookbook is stored
c:\setup\images This is where the images files are

Would I need something to point to this folder in order for it
to find the images files?

I'm assuming that the code you supplied would need to be in a sub routine
then ran when I wanted to get the pictures inserted, is this correct?


Thanks,

<Jeff>

 

[Corey]

Jeff,
The code i pasted uses (res)

I have a cell below the picture location with the address of the image/pic like :
\\Server\server\My Pictures\ABC123.jpg

This way it does not matter where the pictures are stored provided they are not renamed or moved.

Corey....
Thank you for the responce Cory, although I do have a concern or two.

I have my image files in a sub folder of the workbook folder, for example

c:\setup This is where the wookbook is stored
c:\setup\images This is where the images files are

Would I need something to point to this folder in order for it
to find the images files?

I'm assuming that the code you supplied would need to be in a sub routine
then ran when I wanted to get the pictures inserted, is this correct?


Thanks,

<Jeff>

 

[Jeff W.]

Cory, I'm sorry but I don't understand

I'm not really a VBA programmer so there are many things that I don't
to change or add in order to get this to work.

On my sheet, in cell A1 I have ball.gif in cell A4 I have bore.gif
in cell A7 I have bull.gif and in cell A10 I have center.gif

I pasted that code into a module inside a sub and it didn't run when I
called
that sub, I have to rem out the "end if" line but then when I run it , it
error's
out on the following line;

Set mypic = SH.Pictures.Insert(res)

I mean this is the line the debugger high lights and I don't really know why
or
where to go from here...

<Jeff>

 

[Corey]

Not realy sure if i am following what you are trying to achieve.

Not sure if this will assist, but he following code will ask for the user to select a picture to
place over a cell:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Need to Select the Required Cell in Column A first (Ensure ALL rows in Column A are identical
height where picture will appear).
Application.ScreenUpdating = False
Sheets("1).Select
If ActiveCell.Height <> 220.5 Then ' Adjust to suit Row Heght you selected
MsgBox "Please Select the Large Photo Cell where you require the Photo FIRST.", vbExclamation
Exit Sub
Else
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim mypic As Picture
Dim res As Variant
'Const sAddress As String = ActiveCell
Set WB = ActiveWorkbook
res = Application.GetOpenFilename _
("Image Files (*.jpg), *.jpg")
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
mypic.ShapeRange.LockAspectRatio = msoTrue
mypic.ShapeRange.Width = 278 ' Sizes picture (Adapt to suit)
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1 0).Value = res ' Places the pictures address in the cell below the
picture
End With
End If
Sheets("JSA Procedure").Protect
Application.ScreenUpdating = True
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Try pasting the above to see if it suits or can be adapted

Corey....

Cory, I'm sorry but I don't understand

I'm not really a VBA programmer so there are many things that I don't
to change or add in order to get this to work.

On my sheet, in cell A1 I have ball.gif in cell A4 I have bore.gif
in cell A7 I have bull.gif and in cell A10 I have center.gif

I pasted that code into a module inside a sub and it didn't run when I
called
that sub, I have to rem out the "end if" line but then when I run it , it
error's
out on the following line;

Set mypic = SH.Pictures.Insert(res)

I mean this is the line the debugger high lights and I don't really know why
or
where to go from here...

<Jeff>

 

[Jeff W.]

I'm not having any luck with this either, it errors out in a few places

What I'm trying to achieve is this;

I have this workbook that reads in cvs data then generates a tool list for
metal cutting machines and some of the people would require a picture
of the tool to be included in the list, there are about 16 pictures total
that
I keep in a folder, c:\setup\images

The tool lists are all different but there is always a picture name in the
1st cell of the row that matches a picture file name in the images folder
its nothing fancy just a simple generic gif image to be places on the
beginning
of the line that has the tool specifications

I figured if I had the file name of the image in the particular cell I could
put in
a formula that would achieve this, but not being a VBA guy I don't really
know
what is best, I just know that what I have tried hasn't work for different
reasons
probably my inexperience.

I do however appreciate you helping, it is just not working...

<Jeff>