Problemstellung:
Für 32Bit und 64Bit Office Versionen
Manchmal benutzt man eine fortlaufende Nummerierung.
Wenn diese kein Autowert ist möchte man vielleicht manchmal fehlende Nummern (durch Löschung o.ä.) wieder verwenden.
Dies manuell zutun wäre etwas mühselig, aber das kann auch MS-Access.
Lösung:
In der Tabelle in der eine lfd. Nummer eingetragen werden soll muss natürlich das Feld vorhanden sein.
Wir nehmen als Bsp. mal die Tabelle "tbl_Test" und das Feld soll "ArchivNr" lauten.
Jetzt kommen wir zur eigentlichen Funktion zum Ermitteln der Nummer/Zahl.
Public Function GetNextFreeNumber(rRS As DAO.Recordset, sField As String) As Long Dim n As Long Dim nMaxNumber As Long Dim sNumber As String 'Recordset sortieren und höchsten Wert ermitteln rRS.Sort = sField rRS.MoveLast nMaxNumber = rRS(sField) 'DS im Recordset durchlaufen 'Prüfen ob Nummer vorhanden For n = 1 To nMaxNumber sNumber = sField & "=" & n With rRS .FindFirst sNumber If .NoMatch = True Then 'Wenn Nummer nicht vorhanden = Nummer Zähler n GetNextFreeNumber = n Exit For Else 'Wenn Nummer vorhanden; höchster Wert+1 GetNextFreeNumber = nMaxNumber + 1 End If End With Next n End Function
Diese Funktion durchläuft das übergebene Recordset und prüft im angegebenen Feld ob
alle Nummern/Zahlen vorhanden sind. Sind alle vorhanden wird der höchste Wert mit 1 addiert.
Fehlt eine Nummer/Zahl wird die Schleife verlassen und die Funktion gibt die fehlende Nummer/Zahl zurück.
Aufruf:
Private Sub Befehl3_Click() Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("tbl_Test", dbOpenDynaset) MsgBox "Nächste freie Nummer= " & GetNextFreeNumber(rs, "ArchivNr") rs.Close End Sub
Ergebnis:
Weiterlesen...