Sub halts with Run-time error '-2147024809 (80070057) specified value is out of range

[Max]

Hi 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

---

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

 

[Dave Peterson]

If you start a new worksheet and recreate that hyperlink manually -- not copy
and paste, what happens?

(My guess is that it's not the code--something else (who knows what) is
happening.)

 

[Max]

Dave, thanks for comments.
Let me try this at the office tomorrow.
(The source images are located in a network drive)
Will post back further here.

 

[Max]

If you start a new worksheet and recreate that hyperlink manually
-- not copy and paste, what happens?

Just tried it as suggested above,
[ via Insert > Hyperlink, checked link is good,
then manually "converted" the cell's hyperlink to a HYPERLINK formula,
double-checked formula link's good as well and then ran the sub ]
but was hit with the same error msg with these few stubborn cells

The sub writes the path ok in the col to the left,
but the pics don't insert in the comments (empty comment created)

Could I request for a tweak to the sub
to skip such instances and resume its run
with perhaps an "X" written in an empty col ?
(say, 5 cols to the right of the selected col with the HYPERLINK formula)

I could then filter out these "X"'s for manual insertion/action later

Thanks

---

 

[Dave Peterson]

What does the hyperlink look like (just curious)?

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"
If InsertPicComment(myCell, myFormula) = True Then
myCell.Offset(0, 5).Value = ""
Else
myCell.Offset(0, 5).Value = "x"
End If
End Select
End If
End If
End If
Next myCell


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

Dim testStr As String

testStr = ""
On Error Resume Next
testStr = Dir(PictFileName)
On Error GoTo 0

InsertPicComment = False
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
On Error Resume Next
myCell.Comment.Shape.Fill.UserPicture PictFileName
If Err.Number <> 0 Then
'it failed
Err.Clear
Else
InsertPicComment = True
End If
On Error Resume Next
End If

End Function

:
If you start a new worksheet and recreate that hyperlink manually
-- not copy and paste, what happens?

Just tried it as suggested above,
[ via Insert > Hyperlink, checked link is good,
then manually "converted" the cell's hyperlink to a HYPERLINK formula,
double-checked formula link's good as well and then ran the sub ]
but was hit with the same error msg with these few stubborn cells

The sub writes the path ok in the col to the left,
but the pics don't insert in the comments (empty comment created)

Could I request for a tweak to the sub
to skip such instances and resume its run
with perhaps an "X" written in an empty col ?
(say, 5 cols to the right of the selected col with the HYPERLINK formula)

I could then filter out these "X"'s for manual insertion/action later

Thanks

---

 

[Max]

Marvellous, Dave, the revised sub runs exactly as required.
Many thanks !

.. What does the hyperlink look like (just curious)?

An example is:
=HYPERLINK("G:\xxx\zzz_picBrowser\MX TK Rd 396\MX TK Road ( Side View zzz)
Pic 2.jpg","MX TK Road ( Side View zzz) Pic 2.jpg")

---

 

[Dave Peterson]

I don't see any problem with your hyperlink sample. And I still don't know why
it would fail.

Ah, who knows?????

 

[Max]

I don't see any problem with your hyperlink sample.
And I still don't know why it would fail.
Ah, who knows?????

Neither do I .. the beauty in little mysteries linger <bg>

Thanks again for the options you provided

For the record, your subs have since sailed through
2 other heavy duty runs to insert 1,000 and 1,500 images
Resultant file sizes are a massive: 100 MB, 350 MB
and take a while to open/close, but everything works fine.

---

 

[Dave Peterson]

100MB and 350MB. Good gawd, I'm surprised anything works. <bg>

 

[Max]

"Dave Peterson"

100MB and 350MB. Good gawd, I'm surprised anything works. <bg>

.... there's a 600+MB one done up, and under testing
... so far it looks fine, too <g>

---

 

[Dave Peterson]

It sounds scary to me.

Hope you have backups!

"Dave Peterson"
... there's a 600+MB one done up, and under testing
.. so far it looks fine, too <g>

---

 

[Max]

It sounds scary to me.
Hope you have backups!

Certainly, thanks !

---