Pages

Saturday, July 16, 2011

Match the cell value with image name in a folder then add image as comment

you have saved multiple images in a folder and you want to add those images as comment to cells where image name and cell value are same]

Here is the code-
Sub add_comment_images()

Dim fld, fil As Object
Dim swa, srchrange As Range
Dim type1, name1 As String

Set srchrange = Selection.Cells
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder("C:\Documents and Settings\ashish\Desktop\image folder")
For Each fil In fld.Files
type1 = Right(fil.name, Len(fil.name) - Application.WorksheetFunction.Find(".", fil.name))
' add any more image types in if ststaement below u like to search
If type1 = "jpg" Or type1 = "bmp" Then

name1 = Left(fil.name, Application.WorksheetFunction.Find(".", fil.name) - 1)

For Each swa In srchrange
If name1 = swa.Value Then
' if u want to add any text
swa.AddComment.Text "akoul.blogspot.com"
swa.Comment.Shape.Fill.UserPicture fil.Path

Exit For

End If

Next swa

End If


Next fil
End Sub
-----------------------------------------------------
'or
Sub add_comment_images_method2 ()

Dim fld, fil As Object
Dim swa, srchrange As Range
Dim type1, name1 As String
Dim a As Boolean
Set srchrange = Selection.Cells
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder("C:\Documents and Settings\ashish\Desktop\image folder")

For Each swa In srchrange
a = False
For Each fil In fld.Files

type1 = Right(fil.name, Len(fil.name) - InStr(fil.name, "."))
' add any more image types in if ststaement below u like to search
If type1 = "jpg" Or type1 = "bmp" Then

name1 = Left(fil.name, InStr(fil.name, ".") - 1)


If swa.Value = name1 Then
' if u want to add any text
swa.AddComment.Text "akoul.blogspot.com"
swa.Comment.Shape.Fill.UserPicture fil.Path
' offset uses these two
swa.Offset(0, 1).AddComment.Text "akoul.blogspot.com"
swa.Offset(0, 1).Comment.Shape.Fill.UserPicture fil.Path
a = True
Exit For
End If
End If
Next fil
If a = False Then

MsgBox "No Photo found For---------> " & swa.Value

End If


Next swa
End Sub

Images Folder http://www.filefactory.com/file/cc6e6d6/n/image_folder.rar

Excel Macro file http://www.filefactory.com/file/cc6e60b/n/add_images_as_comment.xlsm

2 comments:

  1. Hi ashish,

    I am trying to look for a cell value against the file names that are saved in folder and if the match is a success then to open that excel file and copy a specific value from the cell and paste onto the working sheet. Can you help me to adapt that into this.. Many thanks for you help ?

    ReplyDelete
  2. @Tamir


    can you please share the sample file on koul.ashish@gmail.com

    or post it on

    https://groups.google.com/forum/?fromgroups#!forum/excelvbamacros

    ReplyDelete