Just curious about Savefile.com.

Won't your files go away if they're not download in 14 days?

Max wrote:

Terrific. Runs great !
Thanks for the options ..
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Dave Peterson" wrote in message
...
I'm kind of confused about what to do with the comment string--if there's
already a comment there what should happen? But you should be able to
fiddle
with that to get what you want.

Option Explicit
Sub testme()
Dim LastRow As Long
Dim FirstRow As Long
Dim iRow As Long
Dim wks As Worksheet
Dim myFormula As String
Dim QuotePos As Long

Set wks = Worksheets("sheet1")
With wks
FirstRow = 7
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For iRow = FirstRow To LastRow
If .Cells(iRow, "B").HasFormula Then
myFormula = LCase(.Cells(iRow, "B").Formula)
If myFormula Like "=hyperlink(""*" Then
myFormula = Mid(myFormula, 13)
QuotePos = InStr(1, myFormula, Chr(34), vbTextCompare)
If QuotePos = 0 Then
'do nothing
Else
myFormula = Left(myFormula, QuotePos - 1)
.Cells(iRow, "a").Value = myFormula
Select Case Right(myFormula, 4)
Case Is = ".jpg", ".bmp", ".gif"
Call InsertPicComment(.Cells(iRow, "B"), _
myFormula)
End Select
End If
End If
End If
Next iRow
End With

End Sub
Sub InsertPicComment(myCell As Range, PictFileName As String)

Dim testStr As String

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:=testStr
Else
myCell.Comment.Text Text:=myCell.Comment.Text & "--" & testStr
End If
myCell.Comment.Shape.Fill.UserPicture PictFileName
End If

End Sub

--

Dave Peterson