List image names into col & fill cell comments with corresp images
 

Hi guys,

In say D:\Test

I've got a bunch of images, eg:
image1.jpg
image2.gif
etc

I'd like a sub to dump all the image names in that folder into a col, say in
A2 down, ie:
image1
image2
etc

and then paste/fill the corresponding images into the comments for the
cells. So that the cell with image1 will have a comment pasted with
image1.jpg, image2's comment will house image2.gif and so on. I could then
easily browse the images via the comments. Thanks
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

List image names into col & fill cell comments with corresp images
 

Hi you could give this a try it doesn't add a picture to the cell
comment as I'm not sure if that can be done or not but this will add
an autoshape beside the cell and display the picture in it.

To add your images to the sheet add a userform with a button and add
this code to the button.

Option Explicit
Dim fName As String

Private Sub CommandButton1_Click()
[A2].Select
fName = Dir("C:\pics\*.*") 'change this to your directory
Do While Len(fName) 0
ActiveCell.Value = fName
ActiveCell.Offset(1, 0).Select
fName = Dir
Loop
End Sub

Then add this code to the module for sheet 1

Option Explicit
Dim H, V As Integer
Dim MyDoc
Dim i As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set MyDoc = Sheets(1)
H = Target.Offset(0, 1).Left
V = Target.Offset(0, 1).Top
If Target.Value = "" Then
Exit Sub
End If
i = MyDoc.Shapes.Count
If i 1 Then
MyDoc.Shapes("Comment").Select
Selection.Delete
MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select
Selection.Name = "Comment"
Selection.ShapeRange.Fill.UserPicture "C:\Pics\" & Target.Value
Else
MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200, 100).Select
Selection.Name = "Comment"
Selection.ShapeRange.Fill.UserPicture "C:\Pics\" & Target.Value
End If
End Sub

Hope this is of some use to you

S

List image names into col & fill cell comments with corresp images
 

Many thanks for the response ! Think I got it running but w/o a userform
(I'm not familiar with userforms). I used a command button in Sheet1 to list
the images (this runs good, thanks), then manually copied and pasted the
list into Sheet2 in A2 down. I pasted your Worksheet_SelectionChange code
into the module for Sheet2, amended it a/c and it seems to run ok.

I'd need 2 amendments:
a. How do I load all the images into the file itself so that it's self
contained and can be emailed elsewhere ?
b. Is there a way to have it browsable via selecting the cell using the
up/down arrow-keys instead of re-selecting a new cell in the list with the
mouse? The selection currently jumps to the image and stays there.

Thanks
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Incidental" wrote in message
oups.com...
Hi you could give this a try it doesn't add a picture to the cell
comment as I'm not sure if that can be done or not but this will add
an autoshape beside the cell and display the picture in it.

To add your images to the sheet add a userform with a button and add
this code to the button.

Option Explicit
Dim fName As String

Private Sub CommandButton1_Click()
[A2].Select
fName = Dir("C:\pics\*.*") 'change this to your directory
Do While Len(fName) 0
ActiveCell.Value = fName
ActiveCell.Offset(1, 0).Select
fName = Dir
Loop
End Sub

Then add this code to the module for sheet 1

Option Explicit
Dim H, V As Integer
Dim MyDoc
Dim i As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set MyDoc = Sheets(1)
H = Target.Offset(0, 1).Left
V = Target.Offset(0, 1).Top
If Target.Value = "" Then
Exit Sub
End If
i = MyDoc.Shapes.Count
If i 1 Then
MyDoc.Shapes("Comment").Select
Selection.Delete
MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200,
100).Select
Selection.Name = "Comment"
Selection.ShapeRange.Fill.UserPicture "C:\Pics\" & Target.Value
Else
MyDoc.Shapes.AddShape(msoShapeRectangle, H, V, 200, 100).Select
Selection.Name = "Comment"
Selection.ShapeRange.Fill.UserPicture "C:\Pics\" & Target.Value
End If
End Sub

Hope this is of some use to you

S