AW: Auftragsnummer
13.07.2010 05:43:28
fcs
Hallo Sammy,
damit die nächste Nummer ermittelt werden kann muss die vorherige Nummer ja bekannt sein.
Dazu sollte die letzte vergebene Auftrags-Nr. in einer externen Datei gespeichert (Excel oder Textdatei) werden.
Nachfolgend ein Makro mit entsprchender Funktionalität. Das Verzeichnis für die Datei mit der letzten Auftragsnummer muss so gewählt werden, dass alle Bearbeiter, die Aufträge erstellen darauf zugreifen können.
Gruß
Franz
Sub Auftragsnummer()
Dim sNrAlt As String, lNummer As Long, sAuftrag As String
Dim sMonat As String, sKuerzel As String, sJahr As String
Dim Pos1 As Long, Pos2 As Long, Pos3 As Long
Dim sDateiNr As String
'Name der Text-Datei mit der letzten Auftragsnummer
sDateiNr = "C:\Users\Public\Test" & Application.PathSeparator & "AuftragsNr.txt"
If Dir(sDateiNr) = "" Then
'Wenn Datei nicht vorhanden wird neue Datei angelegt mit Startnummer 1
lNummer = 1
sKuerzel = InputBox("Bitte Firmenkürzel eingeben", _
"Auftragsnummer - erste Eingabe", "HUB")
Else
'Einlesen der letzten Auftragsnummer
Open sDateiNr For Input As #1
Line Input #1, sNrAlt
Close #1
'Position der Bindestriche
Pos1 = InStr(1, sNrAlt, "-")
Pos2 = InStr(Pos1 + 1, sNrAlt, "-")
Pos3 = InStr(Pos2 + 1, sNrAlt, "-")
'Einzelelemente der alten Nummer in Variablen schreiben
sKuerzel = Mid(sNrAlt, 1, Pos1 - 1)
sJahr = Mid(sNrAlt, Pos1 + 1, 2)
sMonat = Mid(sNrAlt, Pos2 + 1, 2)
lNummer = CLng(Mid(sNrAlt, Pos3 + 1))
'Prüfen, ob Jahr- oder Monatswechsel
If sJahr Format(Date, "YY") Or sMonat Format(Date, "MM") Then
'fortlaufende Nummer auf 1 setzen
lNummer = 1
Else
'fortlaufende Nummer um 1 erhöhen
lNummer = lNummer + 1
End If
End If
'Neue Auftragsnummer erstellen
sAuftrag = sKuerzel & "-" & Format(Date, "YY") & "-" _
& Format(Date, "MM") & "-" & Format(lNummer, "00")
'neue Nummer eintragen
ActiveSheet.Range("C12") = sAuftrag
'neue Nummer speichern
Open sDateiNr For Output As #1
Print #1, sAuftrag
Close #1
End Sub