'eine laufende Nummer wird in der Datei lfDNr.dat abgelegt und verwaltet! 'hole den Inhalt der Datei und erhöhe diesen um 1 Sub hole_neue_nr() Dim nRechNr As Long nRechNr = GetNewNumber("lfdNr.dat") If nRechNr < 0 Then Exit Sub ActiveCell = nRechNr End Sub 'hole nur den Inhalt der Datei (z.B. bei Korrekturen etc.) Sub hole_alte_nr() Dim nRechNr As Long nRechNr = GetLastNumber("lfdNr.dat") If nRechNr < 0 Then Exit Sub ActiveCell = nRechNr End Sub 'setze den Zähler in der Datei auf einen Startwert Sub setze_neue_nr() Dim nRechNr As Long nRechNr = SetNumber("lfdNr.dat") If nRechNr < 0 Then Exit Sub ActiveCell = nRechNr End Sub 'wer die oberen 3 Subs mit anderen Dateinamen aufruft 'kann auch mehr als einen Zähler "verwalten"! Public Function GetNewNumber(dateiname As String) As Long Dim lFileNr As Long Dim lNr As Long Dim tFN As String On Error GoTo ErrorHandler tFN = ThisWorkbook.Path & "\" & dateiname lFileNr = FreeFile Open tFN For Random As #lFileNr If EOF(lFileNr) = False Then Get #lFileNr, 1, lNr End If lNr = lNr + 1 Put #lFileNr, 1, lNr Close #lFileNr GetNewNumber = lNr Exit Function ErrorHandler: GetNewNummer = -1 End Function Public Function GetLastNumber(dateiname As String) As Long Dim lFileNr As Long Dim lNr As Long Dim tFN As String On Error GoTo ErrorHandler tFN = ThisWorkbook.Path & "\" & dateiname lFileNr = FreeFile Open tFN For Random As #lFileNr If EOF(lFileNr) = False Then Get #lFileNr, 1, lNr End If Close #lFileNr GetLastNumber = lNr Exit Function ErrorHandler: GetLastNummer = -1 End Function Public Function SetNumber(dateiname As String) As Long Dim lFileNr As Long Dim lNr As Long Dim tFN As String On Error GoTo ErrorHandler tFN = ThisWorkbook.Path & "\" & dateiname lFileNr = FreeFile Open tFN For Random As #lFileNr lNr = CLng(ActiveCell) Put #lFileNr, 1, lNr Close #lFileNr SetNumber = lNr Exit Function ErrorHandler: setNummer = -1 End Function