Way to automate adding pictures in a series in Excel?

  • Thread starter Thread starter MS
  • Start date Start date
M

MS

I'm putting a column of pictures of people next to a column with their
names. If I have the pictures together in a folder, with the photo file
names numbered with the corresponding row numbers that the pictures go in,
is there a way to record a macro so that (for instance) 28.jpg will go into
the picture column in row #28, then 29.jpg will go into the picture column
in row #29, etc. In other words, insert a whole series of pictures
(filenames the same as their appropriate row numbers) in their correct
places, by initiating one macro?

If anyone has any idea of how that could be done, I would greatly appreciate
any suggestions on how to do that.
 
Sub AddPictures()
Dim pic As Picture
'ActiveSheet.Pictures.Delete
For Each cell In Range("C2:C4")
cell.Select
Set pic = _
ActiveSheet.Pictures. _
Insert("C:\WINDOWS\" & cell.Row & ".jpg")
pic.Top = cell.Top
pic.Left = cell.Left
' pic.Width = cell.Width
' pic.Height = cell.Height

Next
End Sub

Change C2:C4 to represent the cells where you want the picture.

If you want the pictures to exactly cover the cell, then uncomment the Width
and Height commands.
 
Instead of using the numbers, you could just name the picture files by the
person's name--or just use an additional column that contains the real name of
the picture file.

Option Explicit
Sub testme01()

Dim myPict As Picture
Dim curWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim myPictName As Variant

Set curWks = ActiveSheet
With curWks
Set myRng = .Range("c2", .Cells(.Rows.Count, "C").End(xlUp))
End With

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
ElseIf Dir(CStr(myCell.Value)) = "" Then
'picture not there!
MsgBox myCell.Value & " Doesn't exist!"
Else
With myCell.Offset(0, 3) '3 columns to the right of C (F)
Set myPict = myCell.Parent.Pictures.Insert(myCell.Value)
myPict.Top = .Top
myPict.Width = .Width
myPict.Height = .Height
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
End With
End If
Next myCell

End Sub

I had things like:

c:\my documents\my pictures\mypict.jpg

in those cells.
 
So, should the macro below work to insert the pictures automatically with
the correspondence between the filename and the row #, to know which picture
goes in which cell in the column?

Where it says C2-C4, I replace the Letter with the column number in which I
have the pictures, and replace the number range with the range of rows that
will have pictures inserted? Where it says "C:\Windows" replace that with
the folder where those numbered pictures are located?

What about the text following that in the same line--& cell.Row & ".jpg."
Just like that? Or substitute cell.Row with the first row in which a picture
should be inserted? (Isn't that information already there, in the range
"C2:C4"?) Do I preceded the ".jpg" with the number of the first photo to be
inserted?

By "uncomment", do you mean take away the ' at the bottom of those two
lines?

Sorry for the "dummy" questions, but I am a novice at this.

So I can click on "Write Macro", and paste in that text, with the changes
mentioned above? Anything I missed that requires my input , before saving
the macro?

Thanks a lot for writing it. :-)
 
Sub AddPictures()
Dim pic As Picture
'ActiveSheet.Pictures.Delete
For Each cell In Range("C2:C4") ' < replace with the column letter where
Click to expand...
the pictures will be inserted. Change 2 to the first row where a
picture
will be inserted, change 4 to the last row where a picture will be
inserted
cell.Select
Set pic = _
ActiveSheet.Pictures. _
Insert("C:\WINDOWS\" & cell.Row & ".jpg")
Click to expand...

You want an argument like "c:\mypictures\2.jpg"
cell.row will supply the 2. Replace "C:\Windows\" with
the path to your pictures, put the "\" on the end. Change ".jpg" to
reflect the file extension of your pictures. (but you said the were jpg)

pic.Top = cell.Top
pic.Left = cell.Left
' pic.Width = cell.Width
' pic.Height = cell.Height

Next
End Sub
Click to expand...

Lines preceded with a single quote are commented out - they won't be
executed. To make them executable, remove the singel quote


So assume the pictures (jpg's) go into column F starting with Row 2 to 30
and the pictures are in D:\My Pictures\My Folder"

Sub AddPictures()
Dim pic As Picture
'ActiveSheet.Pictures.Delete
For Each cell In Range("F2:F30")
cell.Select
Set pic = _
ActiveSheet.Pictures. _
Insert("D:\My Pictures\My Folder\" & cell.Row & ".jpg")
pic.Top = cell.Top
pic.Left = cell.Left
' pic.Width = cell.Width
' pic.Height = cell.Height

Next
End Sub

go into the VBE (alt+F11), choose Insert => Module. In the resulting
module, paste in the above code.

go back to Excel (alt+F11)

Go to Tools=>Macro=>Macros, select AddPictures and click the run button.

do this on a copy of your workbook.
 
Thanks a lot, Tom. I really appreciate it. I haven't had a chance to try it
yet, but I will soon, and will report back how it works, if I run into any
problems, if it works perfectly, etc.

Thanks again.
 
Back
Top