Access: Form Return to scroll position after update

Microsoft Access 2003 ADP on SQL Server 2000:

How to return to the same record at the same vertical scroll position in an continuous view form after a refresh of the list

Problem:

I have a form where updating 1 record in the form detail may update other records above / below in the list (via an update trigger.  To enable these updates to show immediately after the SQL Server database is updated I need to refresh the screen however this puts me back to record no 1.  If I use acGoto to get back to the actioned record it is usually (when I'm not on the first or last page of records) scrolled to the top of list thus the users loses the context of where they were.

So I need a solution that after the refresh positions the user to the record they clicked on to initiate the update of the record they were on, and also scroll the data list correctly

i.e. After the refresh:

1. Go to the record that was at the top of the page, then, go to the record that requries the focus to be set..


I found a bit of stuff online (Stefan Liebans stuff etc but it wasn't really simple enough for my needs)

We will use Me.CurrentSectionTop to return twips so we can do this..

 

Reminder:

ShowOpening and closing a form

When you open a form, the following sequence of events occurs for the form:

OpenLoadResizeActivateCurrent

If there are no active controls on the form, the GotFocus event also occurs for the form after the Activate event but before the Current event.

When you close a form, the following sequence of events occurs for the form:

UnloadDeactivateClose

If there are no active controls on the form, the LostFocus event also occurs for the form after the Unload event but before the Deactivate event.


Theory:

(Note that this requires at least one control at record level detail and for the current record to have focus when the user actions it).

If we know:

  • Record no 1 .CurrentSectionTop (twips) for the top record in the list as intCurTopTWIPSFirstRecord
  • Record 2 .CurrentSectionTop - record 1 .CurrentSectionTop (twips) as intCurTopTWIPSIncrement
  • Current record number as lngRecentRecord
  • Current record .CurrentSectionTop (twips) as intRecentRecordTopTwips

We calculate the record that was top of the record list at the time the current record was actioned by the user.

Calulation:

lngRecordAtTopOfScreen = (lngRecentRecord - (intRecentRecordTopTwips - intCurTopTWIPSFirstRecord) / intCurTopTWIPSIncrement)

Then we (in this order move to) last record, lngRecordAtTopOfScreen,  lngRecentRecord) andwe have repositioned our list.


Solution no 1: Was used where the only action available to the user was via buttons on each record..

Notes:

  • after a  "DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, 1" or similar you need to set focus to a control on the record detail to get the twips from Me.CurrentSectionTop
  • on this form cmbYear_Change() sets the record source.
  • RepositionRecordListScrollPosition() does the repositioning.

 

Option Explicit

Dim lngTotalRecords As Long

' details for the most recent record actioned by the user
Dim lngRecentRecord As Long
Dim intRecentRecordTopTwips As Integer

' Our twips values
Dim intCurTopTWIPSFirstRecord As Integer
Dim intCurTopTWIPSIncrement As Integer



Private Sub btnBenchmark_Click()

Dim tempBM As Integer

    ' capture actioned record
    lngRecentRecord = Me.CurrentRecord
    intRecentRecordTopTwips = Me.CurrentSectionTop



    ' Perform update
    If chkBenchmark = 0 Then tempBM = -1 Else tempBM = 0
   
    sql = "UPDATE vwSSP SET Benchmark = " & tempBM _
        & " WHERE suOrder = (SELECT suOrder FROM vwSSP WHERE suID = " & suID & " AND tiFinancialYear = '" & cmbYear & "')" _
        & " AND tiFinancialYear = '" & cmbYear & "'"
       
    cn.Execute sql
   
    Me.Refresh
   
    ' Reposition recordlist
   
    RepositionRecordListScrollPosition
   
    ' Highlight record detail control for users visual reference
    Me.btnBenchmark.SetFocus

   
End Sub


Private Sub cmbYear_Change()

    sql = "from vwSSP WHERE tiFinancialYear = '" & cmbYear & "'"
    Me.RecordSource = "SELECT * " & sql
    Me.OrderBy = "suOrder, suSectionOrder"
    Me.OrderByOn = True
   
    sql = "SELECT count(*) " & sql
    lngTotalRecords = GetValue(sql, 0)
   
    sql = "SELECT dySSByYearLocked from tbDocumentYear WHERE dyDocumentYear = '" & cmbYear & "'"
    boolResult = GetValue(sql, 1)
   
    cmbYear.SetFocus
    If Not boolResult Then
        Me.btnSSP.Enabled = True
        Me.btnBenchmark.Enabled = True
        Me.btnIndividualBenchmark.Enabled = True
    Else
        Me.btnSSP.Enabled = False
        Me.btnBenchmark.Enabled = False
        Me.btnIndividualBenchmark.Enabled = False
    End If

End Sub

Private Sub cmdClose_Click()
    DoCmd.Close acForm, Me.Name
End Sub

Private Sub Form_Load()

    cmbYear = CurrentFinancialYear
    cmbYear_Change

End Sub


Private Sub RepositionRecordListScrollPosition()
   
    Dim lngRecordAtTopOfScreen  As Long
   

    If lngTotalRecords < 2 Then     ' Do we have enough records to get a twips increment?
        intCurTopTWIPSFirstRecord = 0
    Else
        If intCurTopTWIPSFirstRecord = 0 Then   ' Have we already found the twips position for the first record in the list?
            If Me.CurrentRecord <> 1 Then       ' Move to record no 1 if necessary
                DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, 1
            End If
            Me.btnSSP.SetFocus                  ' Ensure focus is on record 1 this needs to be a record detail control
            intCurTopTWIPSFirstRecord = Me.CurrentSectionTop
        End If
       
        If intCurTopTWIPSIncrement = 0 Then     ' Have we already found the twips increment from one record to another?
            If Me.CurrentRecord <> 2 Then       ' Move to record no 2 if necessary
                DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, 2
            End If
            Me.btnSSP.SetFocus                  ' Ensure focus is on record 2 this needs to be a record detail control
            intCurTopTWIPSIncrement = Me.CurrentSectionTop - intCurTopTWIPSFirstRecord  ' Calc increment
        End If
   
        ' Calculate the record that was at the top of the list when the user did an action on lngRecentRecord
        lngRecordAtTopOfScreen = (lngRecentRecord - (intRecentRecordTopTwips - intCurTopTWIPSFirstRecord) / intCurTopTWIPSIncrement)
       
        ' Reposition in record list:
        ' 1 goto the last record first incase to force a rescroll for 2 below
        ' 2 goto the record that was top of the page
        ' 3 goto the actioned record
        DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngTotalRecords
        DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngRecordAtTopOfScreen
        DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngRecentRecord
       
    End If

End Sub

 


 

Solution no 2, was used where data entry was available, but only one data entry control per data record..

Notes:

  • record level data entry control is 'tsValueOnForm'
  • Needed a flag to check if data was updated hence a refresh/reposition was required after a different control receives focus (so if the user moved to a different record via scroll/mouse click it was the record they are clicking on that they end up at..

 

Option Compare Database
Option Explicit

Dim lngTotalRecords As Long

' details for the most recent record actioned by the user
Dim lngRecentRecord As Long
Dim intRecentRecordTopTwips As Integer

' Our twips values
Dim intCurTopTWIPSFirstRecord As Integer
Dim intCurTopTWIPSIncrement As Integer

' Did we have an update?
Dim RecordUpdated As Boolean


Dim MonthtiID As Integer

Dim objFrc As FormatCondition

Private Sub cmbMonth_Change()

    sql = "UPDATE tbUserChoices SET bmMonth = '" & cmbMonth & "' WHERE Username = '" & GlobalUserName & "'"
    cn.Execute sql
    Call SetRecordSource
   
End Sub

Private Sub cmbRegion_Change()

    sql = "UPDATE tbUserChoices SET bmRegion = '" & cmbRegion & "' WHERE Username = '" & GlobalUserName & "'"
    cn.Execute sql
    Call SetRecordSource
   
End Sub

Private Sub cmbSection_Change()

    sql = "UPDATE tbUserChoices SET bmSection = '" & cmbSection & "' WHERE Username = '" & GlobalUserName & "'"
    cn.Execute sql
    Call SetRecordSource
   
End Sub

Private Sub cmbYear_Change()

    sql = "UPDATE tbUserChoices SET bmFY = '" & cmbYear & "' WHERE Username = '" & GlobalUserName & "'"
    cn.Execute sql
    Call SetRecordSource

End Sub


Private Sub cmdClose_Click()

    DoCmd.Close acForm, Me.Name
   
End Sub


Private Sub SetRecordSource()

    If Not (IsNull(cmbMonth.Column(0)) Or cmbMonth.Column(0) = "All") And Not IsNull(cmbYear) Then
        sql = "EXEC GettiID @dmDocumentMonth = '" & cmbMonth.Column(0) & "' ,@tiFinancialYear = '" & CStr(cmbYear) & "'"
        MonthtiID = CLng(GetValue(sql, "0"))
'        MsgBox sql & " .... " & CStr(MonthtiID)
    Else
        MonthtiID = 0
    End If
   
    lblValueColumn.Caption = cmbMonth.Column(0) & " Values"

    sql = " from vwBenchmarks WHERE " _
        & "     tiFinancialYear = '" & cmbYear & "'" _
        & " AND (tiID = " & MonthtiID & " OR " & MonthtiID & " = 0)" _
        & " AND (DisplayRegion = '" & CStr(cmbRegion) & "' OR '" & UCase(cmbRegion) & "' = 'ALL')" _
        & " AND (seID   = '" & CStr(cmbSection) & "' OR '" & CStr(cmbSection) & "' = '0')"

    If GlobalUserName = "rossli" Then
        sql = InputBox("RecordSource:", "Benchmark edit screen", sql)
    End If
       
    Me.RecordSource = "SELECT * " & sql
    Me.UniqueTable = "tbBenchMark"
    Me.OrderBy = "suOrder, suSectionOrder, Region, tiID"
    Me.OrderByOn = True
   
    sql = "SELECT COUNT(*) " & sql
    lngTotalRecords = GetValue(sql, 0)
   
    Me.Requery
   
End Sub

Sub SetupFormatConditionsView(target As String)

    Me.Controls(target).FormatConditions.Delete
   
    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[Header] <> 0")
    With Me.Controls(target).FormatConditions(0)
        .Enabled = False
        .BackColor = 11527118
    End With
   
    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[NotEditable] <> 0")
    With Me.Controls(target).FormatConditions(1)
        .BackColor = 15728632
        .Enabled = False
    End With
   
    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[NotEditable] = 0")
    With Me.Controls(target).FormatConditions(2)
        .Enabled = False
        .BackColor = 15728632 '11527118 ' 15660020 '15728632 '16777215
    End With
   
End Sub

Sub SetupFormatConditionsEdit(target As String)

    Me.Controls(target).FormatConditions.Delete

    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[Header] <> 0")
    With Me.Controls(target).FormatConditions(0)
            .Enabled = False
            .BackColor = 11527118
    End With

    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[NotEditable] <> 0")
    With Me.Controls(target).FormatConditions(1)
            .Enabled = False
            .BackColor = 15728632
    End With

    Set objFrc = Me.Controls(target).FormatConditions.Add(acExpression, , "[NotEditable] = 0")
    With Me.Controls(target).FormatConditions(2)
            .Enabled = True
            .BackColor = 16777215
'            .FontBold = True
    End With

End Sub


Private Sub Form_Load()

    DoCmd.Maximize
    Me.RecordSource = "select * from vwBenchmarks where 1 = 2"
    RecordUpdated = False
'    Application.Echo False
   
    SetupFormatConditionsView ("NumberOnForm")
    SetupFormatConditionsView ("DescnOnForm")
    SetupFormatConditionsView ("MonthOnForm")
    SetupFormatConditionsView ("RegionOnForm")
    SetupFormatConditionsEdit ("tsValueOnForm")

    sql = "SELECT * FROM tbUserChoices WHERE Username = '" & GlobalUserName & "'"
    Set rs = New ADODB.Recordset
    rs.Open sql, cn, adOpenKeyset, adLockOptimistic, adCmdText
    cmbYear.DefaultValue = Chr(34) & rs.Fields("bmFY") & Chr(34)
    cmbMonth.DefaultValue = Chr(34) & rs.Fields("bmMonth") & Chr(34)
    cmbRegion.DefaultValue = Chr(34) & rs.Fields("bmRegion") & Chr(34)
    cmbSection.DefaultValue = Chr(34) & rs.Fields("bmSection") & Chr(34)
   
    rs.Close
   
    Call SetRecordSource
   
    Application.Echo True

End Sub


Private Sub ReFreshAndRepositionForm()

    RecordUpdated = False

    Dim lngRecordAtTopOfScreen  As Long
   
    ' capture current record
    lngRecentRecord = Me.CurrentRecord
    intRecentRecordTopTwips = Me.CurrentSectionTop
   
    If lngTotalRecords < 2 Then     ' Do we have enough records to get a twips increment?
        intCurTopTWIPSFirstRecord = 0
    Else
        If intCurTopTWIPSFirstRecord = 0 Then   ' Have we already found the twips position for the first record in the list?
            If Me.CurrentRecord <> 1 Then       ' Move to record no 1 if necessary
                DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, 1
            End If
            Me.tsValueOnForm.SetFocus                  ' Ensure focus is on record 1 this needs to be a record detail control
            intCurTopTWIPSFirstRecord = Me.CurrentSectionTop
        End If
       
        If intCurTopTWIPSIncrement = 0 Then     ' Have we already found the twips increment from one record to another?
            If Me.CurrentRecord <> 2 Then       ' Move to record no 2 if necessary
                DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, 2
            End If
            Me.tsValueOnForm.SetFocus                  ' Ensure focus is on record 2 this needs to be a record detail control
            intCurTopTWIPSIncrement = Me.CurrentSectionTop - intCurTopTWIPSFirstRecord  ' Calc increment
        End If
   
        ' Calculate the record that was at the top of the list when the user did an action on lngRecentRecord
        lngRecordAtTopOfScreen = (lngRecentRecord - (intRecentRecordTopTwips - intCurTopTWIPSFirstRecord) / intCurTopTWIPSIncrement)
       
        ' Reposition in record list:
        ' 1 goto the last record first incase to force a rescroll for 2 below
        ' 2 goto the record that was top of the page
        ' 3 goto the actioned record
        Me.Refresh
        DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngTotalRecords
        If lngRecordAtTopOfScreen > 0 Then
            DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngRecordAtTopOfScreen
        End If
        DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lngRecentRecord
        Me.tsValueOnForm.SetFocus
       
    End If

End Sub

Private Sub tsValueOnForm_AfterUpdate()

    RecordUpdated = True
   
End Sub

Private Sub tsValueOnForm_GotFocus()

    If RecordUpdated Then
        ReFreshAndRepositionForm
    End If
   
End Sub