View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Sub to extract path from hyperlink formula and insert picture intocomments

Parsing formulas is never easy, but if you know what those =hyperlink() formulas
look like you could use something like:

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)
Select Case Right(myFormula, 4)
Case Is = ".jpg", ".bmp", ".gif"
.Cells(iRow, "a").Value = myFormula
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:="" 'or "new comment here!" 'or ""
End If
myCell.Comment.Shape.Fill.UserPicture PictFileName
End If

End Sub

You don't really need this line:
..Cells(iRow, "a").Value = myFormula
to get the picture in the comment.

This will not work with:

=hyperlink(If(a1="x","....","----"),"click me")
kind of formula.

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