Ich habe vor einiger Zeit einen VBA Code von euch bekommen, der mir eine fortlaufende Auftragsnummer erzeugt (der Code arbeitet wunderbar). Die Aufttragsnummer setzt sich aus einem Firmenkürzel, dem Jahr, dem Monat und der fortlaufenden Nummer zusammen. Beispiel "XXXX" (Frimenkürzel) "10" (Jahr) "08" (Monat) "01 (Fortlaufende Nummer). Die Auftragsnummer wird in einer .txt Datei gespeichert. Die Arbeitsmappe besteht aus 4 Tallenblätter. Die Blätter heißen "Rohdaten, Transportauftrag, Tabelle2 und Tabelle3. Nun möchte ich gerne, wenn das Makro gestartet wird, die neue Auftragsnummer erzeugen, das das Blatt Transportauftrag auf dem Standart Drucker gedruckt und nur das Blatt "Transportauftrag in den Ordner Archiv Transportaufträge abgespeichert wird. Der Ordner Archiv Transportaufträge befindet sich im gleichen Verzeichniss, wie dieses Sheet.
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 = ThisWorkbook.Path & 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
Gruß Sammy