A personal repository of random information in compensation for a fatigued biological computer
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: Opening and closing a form When you open a form, the following sequence of events occurs for the form: Open → Load → Resize → Activate → Current 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: Unload → Deactivate → Close 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:
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:
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:
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 |