Ps. Add as many extensions as you want to support pictures. I didn't include
all of them <bg.

Max wrote:

Hi guys,

Looking for help to amend/enhance the Sub InsertPicComment() below (from
Dave P)
to do a few other things at one go

In col B are lots of hyperlink formulas below such as in say, B7 down:
=HYPERLINK("G:\...\Airline.jpg","Airline House.jpg")

a. Extract the path: "G:\...\Airline.jpg" into col A (into A7)
b. Insert the pictu Airline.jpg into the comment for B7
c. Skip step (b) if the file is not a picture file
(there could be hyperlinks in col B to non-picture files such as: .xls,
.ppt, .db, etc)
d. Do nothing where col B does not contain hyperlink formulas (eg: blank
cells, etc)

Thanks
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---

Sub InsertPicComment()
' Dave Peterson
Dim myCell As Range
Dim myRng As Range
Dim testStr As String
Dim PictFileName As String

Set myRng = Selection
For Each myCell In myRng.Cells

PictFileName = myCell.Offset(0, -1).Value
testStr = ""
On Error Resume Next
testStr = Dir(PictFileName)
On Error GoTo 0
If testStr = "" Then
'do nothing, picture not found

Else
If myCell.Comment Is Nothing Then
myCell.AddComment Text:="" 'or "new comment here!" 'or ""
End If
myCell.Comment.Shape.Fill.UserPicture PictFileName
End If

' Else
' If myCell.Comment Is Nothing Then
' myCell.AddComment Text:=""
' End If
' myCell.Comment.Shape.Fill.UserPicture PictFileName
' myCell.Comment.Shape.LockAspectRatio = msoTrue
' myCell.Comment.Shape.Height = 143.25
' End If
Next myCell
End Sub

--

Dave Peterson