LinkBack URL
About LinkBacksHi guys,
I'm using Dave Peterson's sub,
re: http://tinyurl.com/ejpmo
(sub is pasted below for easy ref)
It works terrific 99.999% of the time (and I'm really grateful),
... but I'm still unable to overcome a few instances of sub halts
where the error msg would read:
Run-time error '-2147024809 (80070057)
The specified value is out of range
and Debug would point at this line:
myCell.Comment.Shape.Fill.UserPicture PictFileName
(a line within Sub InsertPicComment)
In Excel, the comment would be created for that particular cell
where the sub halts, but w/o the picture inserted
I've checked that the hyperlink for the cell is fine
(clicking on it opens the image)
and the linked image size (.jpg) is also no different (about the same size)
from those for other cells where the sub ran beautifully
Repeated attempts to reset and re-run the sub
on just that single stubborn cell proved fruitless
(I've had to resort to manually inserting the pic
into the comment for such cases <g>)
Wondering whether there's anything I could do over here
to overcome the above
If the above is difficult to resolve,
I'd like the sub to skip over the instance(s)
and just continue running ..
P/s: I'm using Excel 97 in Win XP
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
Option Explicit
Sub testme()
'select range, Dave Peterson
Dim wks As Worksheet
Dim myFormula As String
Dim QuotePos As Long
Dim myRng As Range
Dim myCell As Range
Set wks = ActiveSheet
With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(Selection, .UsedRange)
On Error GoTo 0
End With
If myRng Is Nothing Then
MsgBox "not in the used range"
Exit Sub
End If
For Each myCell In myRng.Cells
If myCell.HasFormula Then
myFormula = LCase(myCell.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)
If myCell.Column > 1 Then
myCell.Offset(0, -1).Value = myFormula
End If
Select Case Right(myFormula, 4)
Case Is = ".jpg", ".bmp", ".gif", ".png"
Call InsertPicComment(myCell, _
myFormula)
End Select
End If
End If
End If
Next myCell
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
Register To Reply
Bookmarks