MS Access VBA设置连续形式的子窗体的滚动条位置

Question

我有一个包含子表单的表单。子表单是一个连续的表单，所以我可以使用条件格式。使用选项卡控件中的控件，可以更改子窗体上当前所选记录的值。因此，我重新查询子表单以更新子表单连续表单以显示更新的数据。

我可以在子窗体中重新选择正确的记录，但列表中该记录的位置会跳转到子窗体列表的顶部，而不是保持更新前的位置。

我尝试使用子窗体的CurrentSectionTop值进行播放，但是在重新检查子窗体后，我无法正确维护用户在子窗体中的选择位置。

是否有某种方法可以获取子表单连续表单的滚动条位置的当前位置，然后在连续表单被重新查询后在代码中设置该位置？（Stephen Lebans＆＃39;代码执行此操作（请参阅：http://www.lebans.com/SelectRow.htm）对我不起作用，因为我使用的是Access 2013，他的代码无法转换为Access 2013.

这里有一个子窗体连续形式显示的样本，当Record 7是当前选择的记录时：     {连续表格视图的开始}
    []连续表格视图中的记录3     []连续表格视图中的记录4     []以连续形式视图记录5     []连续形式视图中的记录6     [＆gt;]连续格式视图中的记录7     []以连续形式视图记录8     []以连续形式视图记录9     {连续表格视图结束}
    {tab control显示在连续表单子表单下方}

在重新查询子表单之后，这是子表单连续表单显示的样子，但我希望显示看起来与上面相同;显示器应该不将Record 7作为连续表单视图中的顶级记录，因为它原来是视图中的第5条记录所以我希望它是重新查询后的第5条记录：
    {连续表格视图的开始}
    [＆gt;]连续格式视图中的记录7     []以连续形式视图记录8     []以连续形式视图记录9     []以连续形式视图记录10     []连续表格视图中的记录11     []以连续形式视图记录12     []连续形式视图中的记录13     {连续表格视图结束}
    {tab control显示在连续表单子表单下方}

Answer 1

我无法让Wayne G Dunn的解决方案正常工作，但我提出了这个替代方案。这不是很好，但它对我有用。

基本思想是连续形式的每个记录都有一个位置（即屏幕上显示的顶部记录位于位置1，无论它是哪个实际记录）。你有一个表格将这些位置与表格中每条记录的Form.currentSectionTop属性联系起来，这样你就可以弄清楚当前记录的位置。然后在重新查询之后返回到那个位置相对简单。

创建具有位置的表 - 这需要在启动时或某处运行 - 如果用户可以调整大小或者任何可能改变连续形式中可能显示的记录数，则可能需要更频繁。

 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

设置全局变量和一些维护它们的函数。 'NoUpdateRequired'变量是可选的 - 我用它来防止不必要的东西一直在运行。

 Public NoUpdateRequired As Boolean
Public Position As Long

Public Sub Set_NoUpdate()
    NoUpdateRequired = True
End Sub

Public Sub Set_NoUpdateOff()
    NoUpdateRequired = False
End Sub

创建此函数以在您可以测量的属性和实际位置之间进行转换：

 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

在连续形式的当前事件中，您需要：

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

最后，在你想要刷新的位置，你需要这个：

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

Answer 2

以下代码是Stephen Lebans＆＃39;上的代码的子集。网站：http://www.lebans.com/SelectRow.htm。该链接具有指向Access数据库的压缩版本的链接，其中包含处理多个方案的所有代码，但数据库是旧版本，需要进行转换。 Leban先生的代码远远超过了此处所包含的内容，但我只是使用此代码来解决一个特定问题。

（A）创建一个名为＆＃39; clsSetRow＆＃39;并粘贴在以下代码中：

Option Compare Database
Option Explicit

Private mSelTop As Long
Private mCurrentSectionTop As Long

Public Property Get SelTop() As Long
SelTop = mSelTop
End Property

Public Property Let SelTop(x As Long)
mSelTop = x
End Property


Public Property Get CurrentSectionTop() As Long
CurrentSectionTop = mCurrentSectionTop
End Property

Public Property Let CurrentSectionTop(x As Long)
mCurrentSectionTop = x
End Property

（B）在您的表单模块中，在顶部包含以下内容：

Private SR As clsSetRow
Dim lCurRec As Long

（C）添加以下事件处理程序和代码：

Private Sub Form_Load()
Set SR = New clsSetRow
End Sub
Private Sub Form_Current()
' This event can be called during the Form Load event prior to the init of
' our class so we must test for this.
If Not SR Is Nothing Then
    SR.SelTop = Me.SelTop
    SR.CurrentSectionTop = Me.CurrentSectionTop
End If
End Sub
Private Sub Form_AfterInsert()    ' OR JUST USE THE BEFOREINSERT
    lCurRec = Me.CurrentRecord
    'Debug.Print "After Insert, Current: " & Me.CurrentRecord
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)   ' OR JUST USE THE AFTERINSERT
    lCurRec = Me.CurrentRecord
    'Debug.Print "Before Insert, Current: " & Me.CurrentRecord
End Sub

（D）无论您想要重新定位（即在REQUERY之后），请添加以下代码行：

 DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lCurRec       

（E）要对此进行测试，只需添加一个命令按钮，即“Requery”和“GoToRecord”。

注意：只需使用滚动条向上或向下滚动，就不会保存您所在位置的行！你需要建立一个当前的记录＆＃39;为了重新定位。

祝你好运！谢谢Stephen Lebans的代码！