Access: Sort und Filter Recordset und Recordsetclone
Dieses vba Code Beispiel zeigt, wie man ein Formular neu
sortieren kann in vba mit einer laufenden Nummer.
Dabei wird beim Ändern der Sortiernummer lfdNr im Hintergrund mit vba-Code eine Kopie
des Formular-Recordsets gezogen.
Die Kopie wird zu einem Recordsetclone kopiert, sortiert
und gefiltert. Im Recordsetclone werden alle neuen Nummern aufsteigende
geändert und gespeichert.
Nach Änderung der Sortier-Nummern wird das Formular neu sortiert
und geladen und der Bookmark Cursor auf die neue Position gesetzt.
|
Public Sub fg_ReSort_LfdNr()
'----------------<
fg_ReSort_LfdNr() >----------------
'<
bookmark >
Dim ID As Long
ID = ID_Position
Dim actBookmark
actBookmark = Me.Bookmark
'</
bookmark >
'< save
change >
Requery
'</
save change >
Dim actNr As Integer
actNr = 0
'----<
Clone Recordset_Data >----
Dim recClone As Recordset
Set recClone = Me.RecordsetClone
'< Sort
Filter >
recClone.Sort = "lfdNr ASC"
'</
Sort Filter >
Dim intLast As Integer
'--<
@Loop: Clone >--
Set recClone =
recClone.OpenRecordset
If Not recClone.EOF Then recClone.MoveFirst
Do Until recClone.EOF
If recClone("ID_Position") = ID Then
'-< current >-
If actNr = recClone("lfdNr") Then
'< set new Nr >
actNr = actNr
recClone.Edit
recClone("LfdNr") = actNr
recClone.Update
'</ set new Nr >
'< push previous >
actNr = actNr + 1
recClone.MovePrevious
recClone.Edit
recClone("LfdNr") = actNr
recClone.Update
recClone.MoveNext
'</ set new Nr >
intLast = actNr
'</ push previous >
Else
'< set new Nr >
actNr = actNr + 1
recClone.Edit
recClone("LfdNr") = actNr
intLast = actNr
recClone.Update
'</ set new Nr >
End If
'-</ current >-
Else
'< set new Nr >
actNr = actNr + 1
recClone.Edit
recClone("LfdNr") = actNr
intLast = actNr
recClone.Update
'</ set new Nr >
End If
'< next
>
recClone.MoveNext
'</ next
>
Loop
recClone.Close
'--</
@Loop: Clone >--
'----</
Clone Recordset_Data >----
DoCmd.SetOrderBy "lfdNr"
'--<
set Bookmark-Cursor >--
Dim rec As Recordset
Set rec = Me.Recordset
Do Until rec.EOF
If rec("ID_Position") = ID Then
Exit Do
End If
rec.MoveNext
Loop
'--</
set Bookmark-Cursor >--
'----------------</ fg_ReSort_LfdNr()
>----------------
End Sub
|
Einfacher Code zum Sortieren und Filtern der Datenkopie
|
Public Sub fg_Sort_LfdNr()
'----------------<
fg_Sort_LfdNr() >----------------
Dim actNr As Integer
actNr = ctlLfdNr
'----<
Clone Recordset_Data >----
Dim recClone As Recordset
Set recClone = Me.RecordsetClone
'< Sort
Filter >
recClone.Sort = "lfdNr"
recClone.Filter = "lfdNr >" & actNr
'</
Sort Filter >
'--<
@Loop: Clone >--
Set recClone =
recClone.OpenRecordset
recClone.MoveFirst
Do Until recClone.EOF
actNr = actNr + 1
recClone.Edit
recClone("LfdNr") = actNr
recClone.Update
'< next
>
recClone.MoveNext
'</
next >
Loop
recClone.Close
'--</
@Loop: Clone >--
'----</
Clone Recordset_Data >----
'----------------</
fg_Sort_LfdNr() >----------------
End Sub
|