View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Max Max is offline
external usenet poster
 
Posts: 9,221
Default Sub halts with Run-time error '-2147024809 (80070057) specified value is out of range

Hi guys,

I'm using Dave Peterson's sub,
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