Bestellnummer hochzählen

Hallo zusammen,
meine Frage ist bestimmt schon X mal gestellt und beantwortet worden. Hoffe das ich meine Frage verständlich schreiben kann.
Habe ein Bestellformular entworfen, in dem befindet sich eine Bestellnummer die folgendermaßen aussehen sollte: W2015001. Diese Nummer sollte auch hochgezählt werden W2015002, W2015003,....W2015009, W2015010 usw. Beim beenden der Datei sollte eine neue Datei in xlsx mit dem Namen der Bestellnummer (W201501) in einem bestimmten Laufwerk und Ordner erstellt werden. Habe versucht eine Makro zu basteln, bin aber totaler Laie und weiß jetzt nicht mehr weiter. Hier der Code
Private Sub Workbook_Open()
Dim intIndex As Integer, intLine As Integer
Dim intStartLine As Integer, intEndLine As Integer
Dim Jahr As String
Dim Prefix As String
Jahr = Right(Date, 4)
Prefix = "W" & Jahr & "-"
If ThisWorkbook.CustomDocumentProperties.Count = 0 Then
ThisWorkbook.CustomDocumentProperties.Add Name:="Nr", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
End If
ThisWorkbook.CustomDocumentProperties("Nr") = ThisWorkbook.CustomDocumentProperties("Nr") + 1
ThisWorkbook.SaveAs Filename:="U:\Betriebsrat\W2015" & ThisWorkbook.CustomDocumentProperties("Nr") & ".xlsx"
ThisWorkbook.Worksheets("Formular").Range("C21") = Prefix & ThisWorkbook.CustomDocumentProperties("Nr")
With ThisWorkbook.VBProject
For intIndex = 1 To .VBComponents.Count
With .VBComponents(intIndex).CodeModule
For intLine = 1 To .CountOfLines
If .ProcOfLine(intLine, 0) = "Workbook_Open" Then
If intStartLine = 0 Then
intStartLine = intLine
Else
intEndLine = intLine
End If
End If
Next
If intStartLine 0 Then
.DeleteLines intStartLine, intEndLine - intStartLine + 1
Exit For
End If
End With

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rolf,
nachfolgend dein angepasst, so dass die Formular-Datei jeweils mit der letzen lfd. Nr. gespeichert wird und das Bestellformular mit Bestellnummer und ohne Makros gespeichert wird.
Die Makros sind zunächst noch in der gespeicherten Datei vorhanden, aber beim nächsten Öffnen sind sie nicht mehr vorhanden. Ab Excel 2007 ist es nicht mehr erforderlich Code-Zeilen zu löschen. Durch das Dateiformat wird festgelegt, ob die Datei ein VBA-Projekt enthält oder nicht.
Gruß
Franz

Private Sub Workbook_Open()
Dim Jahr As String
Dim Prefix As String
Dim BestNr As Long
If MsgBox("Soll eine neue Bestellung angelegt werden?", _
vbYesNo, "Bestellformular") = vbYes Then
On Error GoTo Fehler
Const strPfad As String = "U:\Betriebsrat\"
Jahr = Right(Date, 4)
Prefix = "W" & Jahr & "-"
BestNr = ThisWorkbook.CustomDocumentProperties("Nr") + 1
ThisWorkbook.CustomDocumentProperties("Nr") = BestNr
ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=strPfad & Prefix & Format(BestNr, "000"), _
FileFormat:=51, addtomru:=True
Application.DisplayAlerts = True
ThisWorkbook.Worksheets("Formular").Range("C21") = Prefix & Format(BestNr, "000")
ThisWorkbook.Save
Else
'do nothing
If MsgBox("Soll Formular-Datei bearbeitet werden?", _
vbQuestion + vbYesNo, "Bestellformular") = vbNo Then
ThisWorkbook.Close
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 5 'Tritt auf, wenn Property "Nr" fehlt
ThisWorkbook.CustomDocumentProperties.Add Name:="Nr", _
LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
Resume
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Sub ResetNr() If ThisWorkbook.FileFormat 52 Then 'Prüfung verhindert, dass lfd. Nr. in neu angelegter xlsx-Datei zurückgesetzt wird. MsgBox "Zähler für lfd. Nr. der Bestellungen zurücksetzen" & vbLf & vbLf _ & "Dieses Makro nur starten, wenn die Datei zum Bearbeiten des Formulars " _ & "geöffnet wurde!", _ vbInformation + vbOKOnly, "Bestell-Formular" Else If MsgBox("Zähler für lfd. Nr. der Bestellungen zurücksetzen?" & vbLf & vbLf _ & "Nach ""Ja"" wird Zähler auf 0 gesetzt und die Datei gespeicher und geschlossen.", _ _ vbQuestion + vbYesNo + vbDefaultButton2, "Bestell-Formular") = vbYes Then ThisWorkbook.CustomDocumentProperties("Nr") = 0 ThisWorkbook.Close savechanges:=True End If End If End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread