Insert Image

[Cy Dodimead]

I have a folder of images which are numerically named 1 thru 171. I want to
insert image 1 into C1, image 2 into C2 etc etc. I have in the past had to
go Insert, Picture, from File. But after a while it become very boring and
tiring. Does any body know of a macro I could record/write to do this for
me? I have never written a macro so please be gently.

On the same note is there a way to get the image in the cell instead of
floating over the cells? Would be nice to size the cell around the image by
double clicking instead of dragging.

 

[Dave Peterson]

Images float over the worksheet--they aren't contained in the cell.

You could put the pictures over each cell or you could put the pictures in a
comment associated with that cell.

This should work if your pictures are all in the same folder and have an
extension of JPG.

Option Explicit
Sub testme()
Dim iCtr As Long
Dim myPath As String
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String

'change to the correct location of the picture files
myPath = "c:\my pictures\test\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
.Pictures.Delete 'remove any existing pictures???
For iCtr = 1 To 2 '171 when you've finished testing!
myPictName = myPath & iCtr & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Picture: " & myPictName & " wasn't found"
Else
Set myPict = .Pictures.Insert(myPictName)
With .Cells(iCtr, "C")
myPict.Top = .Top
myPict.Width = .Width
myPict.Height = .Height
myPict.Left = .Left
myPict.Placement = xlMoveAndSize
myPict.Name = "Pict_" & .Address(0, 0)
End With
End If
Next iCtr
End With
End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[Dave Peterson]

ps. If you want to put the pictures in a comment, you can review the manual
technique that Debra Dalgleish shares:
http://contextures.com/xlcomments02.html#Picture

Option Explicit
Sub testme02()

Dim iCtr As Long
Dim myPath As String
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String

myPath = "c:\my pictures\test\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
For iCtr = 1 To 2 '171 when you've finished testing!
myPictName = myPath & iCtr & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Picture: " & myPictName & " wasn't found"
Else
With .Cells(iCtr, "C")
.ClearComments 'remove any existing comment
.AddComment Text:=""
.Comment.Shape.Fill.UserPicture picturefile:=myPictName
End With
End If
Next iCtr
End With
End Sub