View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Max Max is offline
external usenet poster
 
Posts: 9,221
Default 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