Showing posts with label Match the cell value with image name in a folder then add image as comment. Show all posts
Showing posts with label Match the cell value with image name in a folder then add image as comment. Show all posts

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

Import data from SQL

Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...