Laufende Nummer soll mit jedem neuen Jahr bei 1 anfangen
Stefan
in einem Formular soll ein Feld "Nr" für eine Lfd. Nummer
eingebaut werden, das immer um 1 hochzählt. Mit jedem
neuen Jahr soll wieder bei 1 angefangen werden.
Die Ausgabe soll nur die Laufende Nummer enthalten. Das
Datum ist als Feld im Format "Datum, kurz" in der
Tabelle "Brief" vorhanden, in dem auch die Laufende Nummer
hochgezählt werden soll.
Vielen Dank im Voraus
Stefan
Stefan Dase
Nehmen wir mal an, in der Tabelle "Brief" gibt es ein Datumsfeld
"Briefdatum" und die laufende Nummer "LfdNr", dann könnte das Ereignis "Vor
Aktualisierung" des Formulars folgendermaßen aussehen:
Private Sub Form_BeforeUpdate(Cancel as Integer)
If IsNull(Me!LfdNr) Then
Me!LfdNr = Nz(DMax("[LfdNr]", "Brief"), 0) + 1
End If
End Sub
HTH,
Stefan
"Stefan" <ste...@stefan.com> schrieb im Newsbeitrag
news:574c01c275bf$9f2f0f60$35ef2ecf@TKMSFTNGXA11...
Oliver Schinagl
Hallo Stefan,
Hört sich an als wenn du einen Nummerngenerator brauchst. Grundlage findest
du im Access Developer 's Handbook.
Prinzipiell geht es darum:
Wenn 2 user einen neuen DS in der selben Tabelle erstellen und du nur
soetwas komisches wie
Next_Number = Dmax("Nummer","Tabelle") verwendest, können beide User die
selbe Nummer verwenden und was dann?
Mit einem Nummern-Generator kann das nicht passieren. Da die nächste zu
verwendende Nummer in einer externen mdb liegt, die beim zugriff eines User
für die anderen User gesperrt wird. Der andere User fällt in eine
Warteschleife bis der Erste User seine Nummer hat und bekommt dann die
nächst höhere.
Wenn du in der Tabelle die deine Nummern speichert ein Feld wie "Last_Get"
für das Datum des letzten Zugriff hinzufügst, kannst du im Aufruf
kontrollieren ob sich das Jahr geändert hat und darauf reagieren.
MfG Oliver
Nachfolgend der Code und die MDB die ich verwende.
Wenn etwas nicht funkt bastel! Habe z.B. die Resets für Jahr und Monat seit
der Entwicklung nicht mehr verwendet.
MDB erstellen die die Tabelle Nummerngenerator enthält.
MDB = "Nummern-Kreise.mdb"
Tabellenname: "tbl_Nummern_Generator"
Felder:
Name Typ
Größe Beschreibung
----------------------------------------------------------------------------
-----------------------------------
Feld_Name Text
50 PrimaryKey
Next_Number Long Integer
4 mit 1 beginnen.
Reset_Month Ja/Nein
1 monatlicher Reset
Reset_Year Ja/Nein
1 jährlicher Reset
Last_Get Datum/Uhrzeit
8 Standardwert = Date()
Prefix Text
50 Bei String z.B. "RE-" bei Long z.B. 2002
Data_Type Text
50 "long" oder "String"
Anzahl_Stellen Long Integer
4 auf wieviel Stellen soll aufgefüllt werden. z.B 6 = 000001
Danach Einfach ein neues Modul in deiener MDB erstellen und den Code
einfügen. Die Tabelle "tbl_Nummern_Generator" in deine aktuelle
Datenbank verknüpfen.und fertig ist das ganze. Erstellen eines neuen
Nummern-Kreises in der "tbl_Nummern_Generator" nicht vergessen.
Aufruf : Me.Nummer = GetNextNumber(Feldname)
Option Compare Database
Option Explicit
' ## Anzahl der Versuche im Falle von Sperrkonflickten.
Public Const MaximumRetries = 3
' ## Funktion liefert die nächste zu verwendende Nummer wie in der Tabelle
"tbl_Nummern_Generator definiert".
' ## Wobei "Feldname" den gewünschten Nummernkreis übergibt.
Public Function GetNextNumber(Feldname As String) As Variant
' ## Deklarieren der benötigten Variablen"
Dim DB As Database
Dim rs As Recordset
Dim wrkCurrent As Workspace
Dim DB_Path_Name As String
Dim AktNextNr As Long
Dim StrPreFix As Variant
Dim intNotOpen As Long
Dim i As Long ' ## Zähler für Warteschleife bei Error
3024.
Dim Dat_Typ As Variant ' ## Entnimmt aus der Tabelle den
PArameter für den Datentyp.
Dim Anzahl_Stellen As Variant ' ## Enthält einen Formatstring in der
Form "00000000".
' ## Bei Fehler zur Fehlerroutine (wird für Behandlung der Sperrungen
benötigt).
On Error GoTo Error_Handler
' ## Pfadnamen der MDB ermittel die, die Tabelle "tbl_Nummern_Generator"
enthält.
DB_Path_Name = DLookup("Database", "[MSysObjects]", "[ForeignName] =
'tbl_Nummern_Generator'")
' ## Sanduhr.
DoCmd.Hourglass (True)
' ## Definieren des Workspace, der Database und des RecordSets.
Set wrkCurrent = DBEngine.Workspaces(0)
Set DB = wrkCurrent.OpenDatabase(DB_Path_Name, True)
Set rs = DB.OpenRecordset("SELECT * FROM [tbl_Nummern_Generator] " & _
"WHERE tbl_Nummern_Generator.Feld_Name = '" &
Feldname & "'", dbOpenDynaset, dbDenyWrite)
' ## Wenn kein Datensatz gefunden wurde. Warnmeldung und Prozedurausstieg.
If rs.RecordCount = 0 Then
MsgBox "Sie haben einen Aufruf für eine 'Auto-Nummer' gestartet zu dem"
& vbCrLf & _
"keine Definition vorliegt. Fehler trat im Modul " & vbCrLf & _
"'mod_Nummern_Generator' auf. Übergabewert war '" & Feldname &
"'", vbOKOnly + vbExclamation, "Warnung"
GetNextNumber = -1
Else
With rs
' ## die "Next_Number" der Variablen AktNextNr zuweisen.
AktNextNr = !Next_Number
' ## Überprüfen ob das aktuelle Datum größer ist als das Datum
"last_Get".
' ## Wenn "last_Get" größer ist (theoretisch nicht möglich)
Aufforderung zum
' ## Ändern des Systemdatums. Funktionswert = "False" und
Prozedurausstieg.
If Date < ![Last_Get] Then
GetNextNumber = -1
MsgBox "Das aktuelle Datum ist kleiner als, der letzte Zugriff
auf 'Nummern-Kreise.mdb'" & vbCrLf & _
"Bitte prüfen Sie Ihr Systemdatum. Sollte Ihr Systemdatum
in Ordnung sein wenden" & vbCrLf & _
"Sie sich bitte an Ihren Administrator!", vbOKOnly +
vbCritical, "GetNextNumber"
.Close
GoTo Exit_GetNextNumber
End If
' ## Monatlichen Reset wenn gewünscht behandeln.
If ![Reset_Month] = True Then
If Year(Date) >= Year(![Last_Get]) Then
If Month(Date) > Month(![Last_Get]) Then
AktNextNr = 1
MsgBox "Monat :" & AktNextNr
End If
End If
End If
' ## Jährlichen Reset wenn gewünscht behandeln.
If ![Reset_Year] = True Then
If Year(Date) > Year(![Last_Get]) Then
AktNextNr = 1
MsgBox "Jahr :" & AktNextNr
End If
End If
' ## Erstellen des "Prefix" für die "Next_Number".
StrPreFix = ![Prefix]
' ## Zuweisen des Datentyps für den Funktionswert.
("long","String", Null wird als long interpretiert).
Dat_Typ = ![Data_Type]
' ## Zuweisen der Anzahl führender Nullen.
If ![Anzahl_Stellen] Then Anzahl_Stellen = String(![Anzahl_Stellen],
"0")
' ## Aktuelles Datum als Datum für "last_Get" eintragen.
.Edit
![Next_Number] = AktNextNr + 1
![Last_Get] = Date
.Update
End With
' ## Abhängig vom gewünschten Datentyp des Funktionswertes.
If Dat_Typ = Null Or Dat_Typ = "long" Then
' ## Prefix anfügen, kann aber nur eine Zahl sein (z.B. 2002001)
If IsNull(StrPreFix) Then
GetNextNumber = AktNextNr
Else
If IsNull(Anzahl_Stellen) Then
GetNextNumber = Val(Trim(Str(Val(StrPreFix)) &
Str(AktNextNr)))
Else
GetNextNumber = Val(Trim(StrPreFix + Format(Str(AktNextNr),
Anzahl_Stellen)))
End If
End If
' ## Ansonsten Rückgabewert soll String sein.
Else
If IsNull(StrPreFix) Then
GetNextNumber = AktNextNr
Else
If IsNull(Anzahl_Stellen) Then
GetNextNumber = StrPreFix + Str(AktNextNr)
Else
GetNextNumber = StrPreFix + Format(Str(AktNextNr),
Anzahl_Stellen)
End If
End If
End If
End If
' ## Ende "GetNextNumber".
Exit_GetNextNumber:
' ## Alle verwendeten Objekte zerstören.
Set rs = Nothing
Set DB = Nothing
Set wrkCurrent = Nothing
DoCmd.Hourglass (False)
' ## Prozedurausstieg.
Exit Function
' ## Fehlerbehandlung.
Error_Handler:
' ## Das "Err" Objekt nach erwarteten Fehlern abfragen.
Select Case Err
' ## Für spätere Verwendung wenn der Benutzer selbst die
Nummernkreise definieren kann.
'Case 3008 ' ## Tabelle ist bereits vom aktuellen Benutzer
geöffnet.
Case 3045 ' ## Datei lässt sich nicht öffnen.
' ## Warteschleife die Rechenzeit an das System übergibt.
For i = 1 To 100
DoEvents
Next i
' ## Zugriffszähler für "Error 3045" um 1 erhöhen.
intNotOpen = intNotOpen + 1
' ## Wenn der Zugriffszähler größer ist als "MaximumRetries"
Funktionswert = "False"
' ## Fehlermeldung und Prozedurausstieg.
If intNotOpen > MaximumRetries Then
GetNextNumber = -1
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description,
vbOKOnly + vbCritical, "GetNextNumber"
Resume Exit_GetNextNumber
End If
' ## Resume um nach der Warteschleife das öffnen der Datei
"Nummern-Kreise.mdb" zu versuchen.
Resume
Case Else ' ## sonstige unerwartete Fehler.
' ## Funktionswert = "False", Fehlermeldung und
Prozedurausstieg.
GetNextNumber = -1
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description,
vbOKOnly + vbCritical, "GetNextNumber"
Resume Exit_GetNextNumber
End Select
End Function
"Stefan" <ste...@stefan.com> schrieb im Newsbeitrag
news:574c01c275bf$9f2f0f60$35ef2ecf@TKMSFTNGXA11...
Oliver Schinagl
Hallo!
Bei diesem Beispiel kann es zwar nicht zum Crash kommen da es im
beforeUpdate Ereignis des Formulares ausgelöst wird (Nummer wird erst beim
speichern des neuen Datensatzes vergeben), doch der benutzer kann die Nummer
bei der Eingabe nicht sehen. Und wenn es mit der insert eigenschaft
ausgelöst wird kannst du die Nummer zwar sehen, aber beim Speichern des
Datensatzes kann es in einer MultiUser Umgebung zum Crash kommen.
MfG
Oliver
"Stefan Dase" <stef...@gno.de> schrieb im Newsbeitrag
news:10348507...@news.thyssen.com...
Denis Jedig
"Stefan" <ste...@stefan.com> wrote:
Ist das wirklich _deine_ E-Mail-Adresse?
> in einem Formular soll ein Feld "Nr" für eine Lfd. Nummer
> eingebaut werden, das immer um 1 hochzählt. Mit jedem
> neuen Jahr soll wieder bei 1 angefangen werden.
Du hast die Frage bereits in
<news:26b001c27431$920fe550$37ef2ecf@TKMSFTNGXA13> gepostet und auch
zweifach beantwortet bekommen. Waren die Antworten für dich nicht
brauchbar?
--
Denis Jedig
syneticon GbR
Stefan Meisel
vielen Dank für Eure Antworten. Jedoch brachten beide
Lösungen nicht den gewünschten Effekt.
So erhielt ich bei Deiner SELECT-Anweisung, die ich als
Standardwert im Feld "Nr" angegeben hatte, kein Ergebnis.
Hätte ich sie dort nicht eintragen sollen? Der Zähler hat
dann gar nicht mehr hochgezählt.
Und wie meinst Du das mit Right$(Zaehler,1)? Fällt das Max
dann weg?
Zur E-Mail: Sorry, die möchte ich nicht aller Welt publik
machen. Das wird bei uns nicht ganz so gern gesehen.
Deshalb diese "Krücke"...
Viele Grüße
Stefan
>-----Originalnachricht-----
>.
>
Stefan Meisel
vielen Dank für die Antwort. Hab ich auch gleich
ausprobiert. Aber er bringt als Ergebnis jetzt immer in
meinem Feld "Nr" die 100, die auch nicht hochgezählt wird.
Dumme Frage, aber liegt es evtl. daran, dass da schon
Datensätze existieren (aus dem Jahr 2000). Denn
prinzipiell müsste er ja jetzt wieder bei 1 anfangen. Hm
In Deinem Progrämmchen finde ich auch nicht das
Briefdatum. Wird das nicht weiter benötigt?
Viele Grüße
Stefan
>-----Originalnachricht-----
>.
>
Stefan Dase
Du hast Recht, ich habe vergessen, das Datum zu berücksichtigen! Hier das
Update:
Private Sub Form_BeforeUpdate(Cancel As Integer)
If IsNull(Me!LfdNr) Then
Me!LfdNr = Nz(DMax("[LfdNr]", "Brief", _
"([Briefdatum] Between #" & Year(Me!Briefdatum) & "-01-01# AND #" & _
(Year(Me!Briefdatum) + 1) & "-01-01#)"), 0) + 1
End If
End Sub
Viele Grüße,
Stefan Dase
"Stefan Meisel" <ste...@stefan.com> schrieb im Newsbeitrag
news:59f101c275dc$93886680$35ef2ecf@TKMSFTNGXA11...
[...]
In Deinem Progrämmchen finde ich auch nicht das
Briefdatum. Wird das nicht weiter benötigt?
[...]
Stefan Meisel
an zu zählen, macht dann mit 102 weiter. Werde jetzt mal
ein bißchen umherexperimentieren.
Viele Grüße
Stefan
>-----Originalnachricht-----
>.
>
Stefan Meisel
ich habe jetzt nochmal ein bißchen gesucht und einen
Datensatz für dieses Jahr gefunden, der mit der Nr. 100
versehen ist. Das war das Problem. Jetzt funktioniert
alles.
Viele Grüße
Stefan
>-----Originalnachricht-----
>.
>