View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
FSt1 FSt1 is offline
external usenet poster
 
Posts: 3,942
Default Pop-up photo in worksheet

thanks Leith,
i can use this myself.
regards
FSt1

"Leith Ross" wrote:

On Jul 26, 9:55 am, Li Jianyong
wrote:
Thanks for your message. But I think it can not help me really. To do the
job suggested by you,I prefer to insert the pictures into the sheet. The main
problem is if I insert the photos mannally, it is too much boring works.I
have thousands of record.

"Li Jianyong" wrote:
Dear Experts,


I have worsheet organized like this:
PartNos. Products despription Photo
6102004 Tensioner Photo
6302005 Tensioner Photo
6402005 Tensioner Photo


Thousands of record has put in this list.


the photos has been organized like" 6102004.jpg,6302005.jpg...." ,


I need two possibilty to read the photos:
1. Photos can be inserted into the Collumn C with same row of the File name


2. Pop-up the photo when my mouse point to the filename,like I point
6102004, the 6102004.jpg appear as 1/4 of the screen.


Hope I have explained my question clear enough.


Hello Li Jianyong,

I wrote some code a while ago to add pictures to cell comments. I
modified it for your needs. Copy this code into a standard VBA module
in your workbook project. You will need to change the startup
information. This is the starting cell and worksheet for your data.
Currently, it is cell "A2" on "Sheet1". You can run the macro after
you have saved it, using ALT+F8 keys in Excel to bring up the Macro
Dialog.

'Start of Macro code..........
'Written: July 26, 2008
'Author: Leith Ross
'Summary: The user is prompted to open a jpg file in the chosen
directory. The macro
' scans a given worksheet column for picture names, less the
extension, in
' the chosen directory and places the corresponding picture in
the comment.
' The macro will contiue to process all files until there are
no more files
' or the file name in the cell can't be found.

Sub PicturesToCommentsUsingList()

Dim Answer As String
Dim C As Variant
Dim Cmnt As Excel.Comment
Dim ExtLen As Integer
Dim FileName As String
Dim FolderPath As String
Dim FSO As Object
Dim Pics As New Collection
Dim R As Long
Dim Wks As Worksheet

'Setup the starting cell and worksheet
C = "A"
R = 2
Set Wks = Worksheets("Sheet1")

'Prompt user to select a file from the directory selected
FolderPath = Application.GetOpenFilename("Picture Files (*.jpg),
*.jpg")
If FolderPath = "False" Then Exit Sub

Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")

FileName = FSO.GetFile(FolderPath).Name
ExtLen = Len(FSO.GetExtensionName(FolderPath)) + 1
FolderPath = Left(FolderPath, Len(FolderPath) - Len(FileName))

'Place pictures names and paths in collection object
For Each File In FSO.GetFolder(FolderPath).Files
On Error Resume Next
Pics.Add File.Path, Left(File.Name, Len(File.Name) -
ExtLen)
If Err.Number < 0 Then Err.Clear
On Error GoTo 0
Next File

'Match picture names in the column with the collection
For I = 1 To Pics.Count
With Wks
Set Cmnt = .Cells(R, C).Comment
If Cmnt Is Nothing Then
Set Cmnt = .Cells(R, C).AddComment(Text:="")
End If
On Error Resume Next
Cmnt.Shape.Fill.UserPicture Pics(.Cells(R, C).Text)
If Err.Number < 0 Then
Answer = MsgBox("The Picture " & .Cells(R, C).Text &
" could not be found." & vbCrLf _
& "Do you want to continue?", vbYesNo +
vbDefaultButton2 + vbQuestion)
If Answer = vbNo Then Exit For
End If
R = R + I
End With
Next I

Application.ScreenUpdating = True
Set FSO = Nothing

End Sub
'End of Macro Code..........

Sincerely,
Leith Ross