Leban's scrolling code

[george 16-17]

Greetings,

I installed Stephen Leban's SetGetSB function to hold the same position of a
scroll after requery of a continuous mdb form . I am getting an "runtime
error 3001 - Invalid argument". I must be doing something wrong as very
similar code that worked great on another form (my test form), but does not
on this form. I am using A2007.

The code is based on the a treeview replacement:
http://kerkeslager.net/Darryl/Access/AccessTreeview.html

Here is the code:

Private Sub btnSelect_Click()
'On Error GoTo handle_error

Dim collapsedBranch As Boolean
collapsedBranch = False

'Lebans code - SetGetScrollBars
Dim OrigSelTop As Long
Dim RowsFromTop As Long
Dim OrigCurrentSectionTop As Long

' Must cache the current props because Requery will
' reset them - Lebans
OrigSelTop = SR.SelTop
OrigCurrentSectionTop = SR.CurrentSectionTop

With CurrentDb
'LEVEL ONE
If StrComp(Me("expanded1"), "0", vbBinaryCompare) = 0 Then ' Expand
.Execute "UPDATE t_selected SET expanded1=1 " & _
"WHERE tree_id = '" & Me("tree_id ") & "'", dbFailOnError
.Execute "UPDATE t_selected SET visible=True " & _
"WHERE tree_id LIKE '" & Me("tree_id") & " > *'" & _
" AND [tLevel] = '2'", dbFailOnError
.Execute "UPDATE t_selected SET expanded2=0 " & _
"WHERE tree_id LIKE '" & Me("tree_id") & " > *'" & _
" AND [tLevel] = '2'", dbFailOnError
Else
If StrComp(Me("expanded1"), "1", vbBinaryCompare) = 0 Then '
Collapse
' a branch to be collapsed is currently selected
If InStr(1, selectedID, Me("tree_id") & " > ",
vbBinaryCompare) > 0 Then
.Execute "UPDATE t_selected SET selected=False " & _
"WHERE tree_id ='" & selectedID & "'", dbFailOnError
lastID = vbNullString
selectedID = vbNullString
collapsedBranch = True
End If
.Execute "UPDATE t_selected SET expanded1=0 " & _
"WHERE tree_id = '" & Me("tree_id ") & "'",
dbFailOnError
.Execute "UPDATE t_selected SET visible=False " & _
"WHERE tree_id LIKE '" & Me("tree_id") & " > *'",
dbFailOnError
End If
End If
'LEVEL TWO
If StrComp(Me("expanded2"), "0", vbBinaryCompare) = 0 Then ' Expand
.Execute "UPDATE t_selected SET expanded2=1 " & _
"WHERE tree_id = '" & Me("tree_id ") & "'", dbFailOnError
.Execute "UPDATE t_selected SET visible=True " & _
"WHERE tree_id LIKE '" & Me("tree_id") & " > *'",
dbFailOnError
Else
If StrComp(Me("expanded2"), "1", vbBinaryCompare) = 0 Then '
Collapse
If InStr(1, selectedID, Me("tree_id") & " > ",
vbBinaryCompare) > 0 Then
.Execute "UPDATE t_selected SET selected=False " & _
"WHERE tree_id ='" & selectedID & "'", dbFailOnError
lastID = vbNullString
selectedID = vbNullString
collapsedBranch = True
End If
.Execute "UPDATE t_selected SET expanded2=0 " & _
"WHERE tree_id = '" & Me("tree_id ") & "'",
dbFailOnError
.Execute "UPDATE t_selected SET visible=False " & _
"WHERE tree_id LIKE '" & Me("tree_id") & " > *'",
dbFailOnError
End If
End If
'LEVEL THREE
If Len(lastID) > 0 Then
CurrentDb.Execute "UPDATE t_selected SET selected=False " & _
"WHERE tree_id ='" & lastID & "'", dbFailOnError
End If
CurrentDb.Execute "UPDATE t_selected SET selected=True " & _
"WHERE tree_id ='" & Me("tree_id") & "'", dbFailOnError
selectedID = Me("tree_id")
lastID = Me("tree_id")

End With

' Turn off screen redraw 'lebans
Me.Painting = False

Me.Requery
Me.Recalc

' Calculate how many rows, if any, the selected
' row was from the top prior to the Requery
' Check if Header is visible or not
If Me.Section(acHeader).visible = True Then
RowsFromTop = (OrigCurrentSectionTop -
Me.Section(acHeader).Height) / Me.Section(acDetail).Height
Else
RowsFromTop = OrigCurrentSectionTop / Me.Section(acDetail).Height
End If

'Lebans
' Setting the SelTop property forces this row to appear
' at the top of the Form. We will subtract the number of rows
' required, if any, so that the original current row remains
' at the original position prior to the Requery.
' First set the current record to the last record.
' This is required due to the method that
' that the Access GUI manages the ScrollBar.
Me.SelTop = Me.RecordsetClone.RecordCount
Me.SelTop = OrigSelTop - RowsFromTop
DoEvents
Me.Painting = True
' Now setfocus back to the original row prior to the Requery

'ERROR points to to this line of code:
Me.RecordsetClone.AbsolutePosition = Me.CurrentRecord + RowsFromTop
- 1
Me.Bookmark = Me.RecordsetClone.Bookmark

'Exit Sub
'handle_error:
'MsgBox Err.Description, , Err.Number

End Sub

Thanks in advance and any help is greatly appreciated. Let me know if more
info is needed.
george

 

[george 16-17]

FWIW...
I was able to fix the error. I just needed to set the PK field in the
underlying query to ascending. The form is working fine.
Thanks.

: