Endlosformular nach Aktualisierung an gleicher Position

Microsoft Access 16. 05. 2011

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

Quelle

1 Stern2 Sterne3 Sterne4 Sterne5 Sterne
Loading...
Beitrag drucken

Autor

Manuel

Ich bin Manuel Wurm, IT-Consultant und Blogger. Ich mag es, verschiedenste Dinge auszuprobieren. Vor allem mit Retro-Computern, Bierbrauen, Bogenschießen und Schlagzeug spielen verbringe ich gerne meine Zeit. Kochen zählt zu meinen größten Hobbys - das spiegelt sich auch auf wurmweb.at wieder, wo ich gerne Rezepte teile und hilfreiche Tipps für Interessierte festhalte.