insert pictures to comments from directory

[daxazz]

Hello,

I have a photos database in "C:\pictures\". There are ~20000 photos.
Each .jpg photo is named by 8 digits number. For example: 41152356.jpg, 41152654.jpg, 41158625.jpg and etc.

Also, I have excel document which "A" column consist 8 digits number. ~1000 rows with numbers.

I need a macro which find exact picture and insert it to each cell comment in column "A".

Can anyone help me ?

[Chippy]

Try this:

Please Login or Register  to view this content.

[daxazz]

Hello Chippy,

thank you for response. It is working, but I need that pictures would be original size (or half original size).
Now this script inserts very small pictures..

Can you do this ?
Thanks

[Chippy]

Try this amended code. It temporarily adds the picture (e.g. jpeg image) to the sheet to determine its width and height and uses these values for the comment box size.

Please Login or Register  to view this content.

I've also added the Delete_Comments subroutine which deletes each comment in column A, to make it easier to add or delete comments and play around with the code.

[daxazz]

Chippy, you know what... It is working perfectly!

Thank you so much.

[daxazz]

Chippy, one more thing.. I've just saw that pictures appear in comments in different sizes. Some of them are normal, some of them - small.

for example, original picture is 400x226 in size, but in comments it is inserted very small.

How is that could be ?

[daxazz]

Chippy, earlier I was using this script. But looks like it is not working on 2007 year office. My colleague told so..

Sub CommentImages()
repertoire = "c:\pictures\"
For Each c In Range("A2", [A65000].End(xlUp))
c.ClearComments
c.AddComment
c.Comment.Text Text:=CStr(c)
fichier = CStr(c.Value) & ".jpg"
If Dir(repertoire & fichier) <> "" Then
c.Comment.Shape.Fill.UserPicture repertoire & fichier
taille = TaillePixelsImage(repertoire, fichier)
c.Comment.Shape.Height = Val(Split(taille, "x")(1))
c.Comment.Shape.Width = Val(Split(taille, "x")(0))
c.Comment.Shape.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
c.Comment.Shape.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
End If
Next
MsgBox ("Pictures has been added to comments")
End Sub

Function TaillePixelsImage(repertoire, fichier)
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(repertoire)
Set myFile = myFolder.Items.Item(fichier)
TaillePixelsImage = myFolder.GetDetailsOf(myFile, 26)
End Function


Function TaillePixelsImage(repertoire, fichier)
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(repertoire)
Set myFile = myFolder.Items.Item(fichier)
TaillePixelsImage = myFolder.GetDetailsOf(myFile, 26)
End Function

When I delete rows:
c.Comment.Shape.Height = Val(Split(taille, "x")(1))
c.Comment.Shape.Width = Val(Split(taille, "x")(0))

then it is working, but pictures are added in not original sizes..

Maybe this would help you to adjust your script ?

thanks

[Chippy]

pictures appear in comments in different sizes. Some of them are normal, some of them - small.

for example, original picture is 400x226 in size, but in comments it is inserted very small.

How is that could be ?

It could be due to the resolution of the image, but I don't know exactly, and I have seen the opposite happen. In tests with two specific .jpg images, both 104x94 pixels, image A is expanded (scaled up) when inserted into Excel, whereas image B remains the correct size. When opened in MS Paint they are both the same correct size. Image A file size is 27 Kb, B is 5 Kb.

I analysed them using http://webscriptsonline.com/visitsite.php?link_id=27712 and the main difference is that A has a Photoshop Information Resource Block (IRB) with the following data:

Resolution Info
Horizontal Resolution = 26 pixels per Inch
Vertical Resolution = 26 pixels per Inch
Display units for Horizontal Resolution = Pixels per Inch
Display units for Vertical Resolution = Pixels per Inch
Display units for Image Width = Centimetres
Display units for Image Height = Centimetres

Image B doesn't contain this resolution data.

[Chippy]

Chippy, earlier I was using this script. But looks like it is not working on 2007 year office. My colleague told so..

When I delete rows:
c.Comment.Shape.Height = Val(Split(taille, "x")(1))
c.Comment.Shape.Width = Val(Split(taille, "x")(0))

then it is working, but pictures are added in not original sizes..

Maybe this would help you to adjust your script ?

thanks

The above lines use Shell GetDetailsOf to get the image size in pixels, so it's not surprising that the pictures are incorrectly sized after you delete those lines.

Sorry can't help further because I don't have Excel 2007, but suggest you put Option Explicit at the top of the modules and declare (Dim) all the variables.