Vba – MS Access VBA to set scrollbar position of a subform that is a continuous form

ms-accessms-access-2013vba

I have a form with a subform. The subform is a continuous form so I can use conditional formatting. Using controls in a Tab Control, the values of the currently selected record on the subform are changed. So, I requery the subform to update the subform continuous form to show the updated data.

I can get the correct record re-selected in the subform, but the position of that record in the list jumps to the top of the subform's list instead of maintaining the position it was in prior to the update.

I have tried playing with the CurrentSectionTop values of the subform, but I am not able to correctly maintain the user's selection position within the subform after requerying the subform.

Is there some way to get the current position of the subform's continuous form's scrollbar position and then set that position in code after the continuous form is requeried? (Stephen Lebans' code for doing this (see: http://www.lebans.com/SelectRow.htm) does not work for me because I'm using Access 2013 and his code won't convert to Access 2013).

Here's a sample of what the subform continuous form display might look like to begin with while Record 7 is the current record selected:
{start of continuous form view}
[ ] Record 3 in continuous form view
[ ] Record 4 in continuous form view
[ ] Record 5 in continuous form view
[ ] Record 6 in continuous form view
[>] Record 7 in continuous form view
[ ] Record 8 in continuous form view
[ ] Record 9 in continuous form view
{end of continuous form view}
{tab control displays down here below the continuous form subform}

After the subform is requeried, here is what the subform continuous form display looks like, but I want the display to look the same as above; the display should not put Record 7 as the top record in the continuous form view since it was the 5th record down in the view originally so I want it to be the 5th record down after the requery:
{start of continuous form view}
[>] Record 7 in continuous form view
[ ] Record 8 in continuous form view
[ ] Record 9 in continuous form view
[ ] Record 10 in continuous form view
[ ] Record 11 in continuous form view
[ ] Record 12 in continuous form view
[ ] Record 13 in continuous form view
{end of continuous form view}
{tab control displays down here below the continuous form subform}

Best Answer

I couldn't get Wayne G Dunn's solution working, but I came up with this alternative. It's not wonderful, but it worked for me.

The basic idea is that each record in the continuous form has a position (ie top record showing on the screen is in position 1, regardless which actual record it is). You have a table that relates those positions, to the Form.currentSectionTop property of each record in the form, so you can figure out what position the current record is in. Then it's relatively straightforward to return to that position after the requery.

Create the table with the positions - this needs to run on startup or somewhere - might need to be more frequent if the user can resize or anything might change the number of records that could be shown in the continuous form.

 Public Sub Setup_Positions()
    Dim sql As String
    Dim Position As Long
    Dim currentSectionTop As Long
    Dim lastSectionTop As Long

    sql = "DELETE FROM tblRecordPosition"
    currentdb.execute sql

    DoCmd.GoToRecord , , acFirst

    Position = 1

    Call Set_NoUpdate

    With Forms("frmMain").Controls("frmContinuousSubForm").Form
        currentSectionTop = .currentSectionTop
        Do While currentSectionTop <> lastSectionTop

            'record previous sectiontop
            lastSectionTop = currentSectionTop



            'write it into the table
            sql = "INSERT INTO tblRecordPosition (Position, CurrentSectionTop) " & _
                "SELECT " & Position & ", " & _
                currentSectionTop
            CurrentDb.Execute sql

            'update to next position and record the 'last' one, move to next record. When we've run out of visible ones, the last and current will be the same.
            Position = Position + 1
            DoCmd.GoToRecord , , acNext
            'get new current sectiontop
            currentSectionTop = .currentSectionTop
        Loop

    End With

    Call Set_NoUpdateOff

End Sub

Set up global variables and a couple of functions to maintain them. The 'NoUpdateRequired' variable is optional - I use it to prevent unnecessary stuff running all the time.

 Public NoUpdateRequired As Boolean
Public Position As Long

Public Sub Set_NoUpdate()
    NoUpdateRequired = True
End Sub

Public Sub Set_NoUpdateOff()
    NoUpdateRequired = False
End Sub

Create this function to convert between the property you can measure, and the actual position:

 Public Function Get_Position(Optional InputCurrentSectionTop As Long) As Long
Dim currentSectionTop As Long
Dim Position As Long

If InputCurrentSectionTop > 0 Then
    currentSectionTop = InputCurrentSectionTop
Else
    currentSectionTop = Forms("frmMain").Controls("frmContinuousSubForm").Form.currentSectionTop

End If

Position = Nz(ELookup("Position", "tblRecordPosition", "CurrentSectionTop = " & currentSectionTop), 0)

Get_Position = Position

End Function

In the current event of the continuous form, you need this:

Private Sub Form_Current()
   If NoUpdateRequired = False Then
       Position = Get_Position
   End If
End Sub

And finally, in the bit where you want your refresh to happen, you need this:

Public Sub Refresh_ContinuousSubForm()

'All this problem goes away if you can use Refresh instead of Requery, but if you have a few things editting the underlying table, you must use requery to avoid 'another user has changed the data' errors.  
'However, this then causes the form to jump
'back to the first record instead of keeping the current record selected.  To get around this, the following has been employed:
'the .seltop property allows you to select the top selected record (in most cases, only one record is selected).  This is recorded before the refresh, and
'the form set back to that after the refresh. However, this puts the selected record at the top of the screen - confusing when you're working down a list.
'The .currentSectionTop property measures the number of twips from the selected record to the top of the screen - and correlates to which position in the list
'of 25 records in the bottom pane.  tblRecordPosition converts between the twips to the actual position (recorded when the database is opened).

'The key to all this is that going back to the right record using .seltop only puts the record at the top of the screen IF the record wasn't already visible on the screen.
'But GoToRecord, if used when you're already at the top of the screen, will push the records down the screen as you move backward (upward) through them.
'So we go to the right record, and it will probably be at the top of the screen because of the requery.  Then we push them down the screen back to the original position
'using GoToRecord, but now we're on the wrong record.  Then we return to the right record using .seltop, and because it's already on the screen, it won't move position.

Dim startSeltop As Long
Dim newSectionTop As Long
Dim newPosition As Long
Dim startPosition As Long
Dim recordsToMove As Long
'Also global variable Position (long) which is recorded in the form's current event

Call Set_NoUpdate

startPosition = Position

With Forms("frmMain").Controls("frmContinuousSubForm").Form
    .Painting = False 'stops the screen flickering between
    startSeltop = .SelTop 'records which record we're on.  Position represents where that was showing on the screen.

    .Requery 'does the requery

    .SelTop = startSeltop 'sets us back to the correct record
    newSectionTop = .currentSectionTop 'measures in twips which position it's in (usually 1)
    newPosition = Get_Position(newSectionTop) 'converts that to the position
    recordsToMove = startPosition - newPosition 'calculates how many records to move - moving records using GoToRecord moves the position as well

    If recordsToMove > 0 Then
        DoCmd.GoToRecord , , acPrevious, recordsToMove 'moves back enough records to push our record to the right place on the screen
    End If

    .SelTop = startSeltop 'now sets back to the correct record
    .Painting = True 'turns the screen painting back on
End With

Call Set_NoUpdateOff
End Sub
Related Topic