Nachdem man ein „Requery“ auf ein Endlosformular durchführt, hüpft das Formular wieder unschön zur ersten Zeile. Dies kann man zwar umgehen, in dem man den aktuellen Datensatz als Bookmark speichert; bei einem Sprung zu dem Bookmark landet dieser dann aber in der obersten Zeile.
Eine Lösung, die darauf abzielt, über eine Windows-API die Position der Bildlaufleiste abzurufen und wieder zu setzen, habe ich unter … gefunden.
Leider war ich mit dem Ergebnis nicht ganz zufrieden, daher hier eine (leicht) veränderte Version. Einfach den Quellcode in ein neues Modul kopieren und „frm.Requery“ durch „RequeryFormData frmName, „ID“, Me.EinSteuerelementImDetailbereich“ ersetzen.
Option Compare Database
Option Explicit
'Modul, um die Position der Bildlaufleiste bei einem Formular-Refresh zu behalten
'Quelle: http://wiki.access-codelib.net/Endlosformular_aktualisieren
'Aufruf: RequeryFormData Me, "IDKunde", Me.EinSteuerelementImDetailbereich
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal Hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
'Hilfsfunktion
Public Function GotoFormBookmark(ByVal frm As Form, ByVal BookmarkID_Name As String, ByVal BookmarkID_Value As Variant)
Dim rst As Object
Dim strCriteria As String
If IsNumeric(BookmarkID_Value) Then
strCriteria = BookmarkID_Name & "=" & BookmarkID_Value
Else
strCriteria = BookmarkID_Name & "='" & Replace(BookmarkID_Value, "'", "''") & "'"
End If
Set rst = frm.Recordset.Clone 'Recordset wegen Ac2000, da hier bei ADO kein Recordsetclone möglich ist!
If TypeOf rst Is DAO.Recordset Then
With rst
.FindFirst strCriteria
If .NoMatch = False Then
frm.Bookmark = .Bookmark
End If
End With
'ElseIf TypeOf rst Is ADODB.Recordset Then
' With rst
' .Find strCriteria, , adSearchForward
' If Not .EOF Then
' frm.Bookmark = .Bookmark
' End If
' End With
End If
Set rst = Nothing
End Function
Public Sub RequeryFormData(ByVal frm As Form, ByVal DataSourceUniqueFieldName As String, _
Optional ByVal DetailSectionControl As Control = Nothing)
' DataSourceUniqueFieldName ... Name eines eindeutigen Datenfeldes um den aktuellen Datensatz zu identifizieren
' DetailSectionControl ... Referenz auf Steuerelement im Detailbereich,
' damit bei Bedarf der Fokus in den Detailbereich verlegt werden kann.
' Wird keine Steuerelementreferenz übergeben, wird das "erstbeste" Steuerelement
' im Detailbereich ausgewählt
Dim varIDValue As Variant
Dim lngPos As Long, lngPosDiff As Long
Dim lngDirection As Long
Dim ctl As Control
Dim i As Long
frm.Painting = False
'Aktuelle Position merken
' Fokus muss im Detailbereich sein, sonst funktioniert CurrentSectionTop nicht
If frm.ActiveControl.Section <> acDetail Then
If Not DetailSectionControl Is Nothing Then
DetailSectionControl.SetFocus
Else
For Each ctl In frm.Section(acDetail).Controls
Select Case ctl.ControlType
Case acCommandButton, acTextBox, acComboBox
If ctl.Enabled Then
ctl.SetFocus
Exit For
End If
End Select
Next
End If
End If
lngPos = (frm.CurrentSectionTop - frm.Section(acHeader).Height) \ frm.Section(0).Height
'Wert vom Datensatz-Identifizierer merken
varIDValue = Null
If Len(DataSourceUniqueFieldName) > 0 Then
With frm.Recordset
If .RecordCount > 0 Then
varIDValue = .Fields(DataSourceUniqueFieldName).Value
End If
End With
End If
'jetzt darf Requery ausgeführt werden
frm.Requery
'DS und Position nur dann einstellen, wenn zuvor ein DS identifiziert werden konnte
If Not IsNull(varIDValue) Then
'zu Bookmark springen
GotoFormBookmark frm, DataSourceUniqueFieldName, varIDValue
'letzte Position wieder herstellen
lngPosDiff = lngPos - ((frm.CurrentSectionTop - frm.Section(acHeader).Height) \ frm.Section(0).Height)
If lngPosDiff <> 0 Then
If lngPosDiff > 0 Then
lngDirection = SB_LINEUP
Else
lngDirection = SB_LINEDOWN
lngPosDiff = Abs(lngPosDiff)
End If
For i = 1 To lngPosDiff
SendMessage frm.Hwnd, WM_VSCROLL, lngDirection, 0&
Next i
End If
End If
frm.Painting = True
End Sub
Loading…