Wiki der Access Code Library

Gemeinsam zu mehr Effizienz in der Anwendungserstellung

Endlosformular aktualisieren

Aus Access Code Library
Wechseln zu: Navigation, Suche
Programmier-Konzepte

Inhalt

Wenn bei einem Endlosformular ein Requery ausgeführt wird, erhält der erste Datensatz im Formular-Recordset den Fokus.

Den Fokus auf den zuletzt aktiven Datensatz kann man durch Einstellen der Bookmark-Eigenschaft setzen.

Beispiel:

Dim lngCurrentID as Long
lngCurrentID = Me!ID
Me.Requery
GotoFormBookmark Me, "ID", lngCurrentID

Hilfsfunktion GotoFormBookmark

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

Mit diesem Ablauf ist aber nicht sichergestellt, dass auch die Position des aktuellen Datensatzes erhalten bleibt. Und das zu erreichen,kann die API-Funktion SendMessage mit WM_VSCROLL und SB_LINEUP/SB_LINEDOWN verwendet werden.

Hilfsfunktion RequeryFormData mit API-Aufruf von SendMessage

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
 
 
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 i As Long
 
   '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
 
End Sub

Anwendung:

RequeryFormData Me, "ID", Me.EinSteuerelementImDetailbereich

Arr_l.png Formularsteuerung