laufende Nummer vergeben

Hallo Leute,
da mir bisher immer super geholfen wurde wende ich mich mal wieder an Euch mit einem für mich nicht lösbaren Problem. Habe im Archiv schon rund 2 Stunden zugebracht da es schon viele Beiträge zum Thema gibt, bin aber leider nicht fündig geworden ein paar Ansätze hab ich gefunden aber eben nicht das was ich suche.
Nun mal zum Problem: Ich möchte eine laufende Nummer vergeben lassen. Diese soll ab einer bestimmten Zahl beginnen und beim öffnen meiner Vorlage (als .xlt gespeichert) automatisch um eins hochgezählt werden so dass keine Doppelvergabe stattfinden kann. Diese neue Nummer muss dann in die xlt. zurückgeschrieben werden um beim neuen öffnen wieder hochgezählt werden zu können. Danach wird die Arbeitmappe per Makro an einem bestimmten Ort unter einem bestimmten Namen gespeichert und gedruckt. Dies hab ich schon mit eurer Hilfe realisieren können. Natürlich darf beim erneuten öffnen dieser Mappe dann die Nummer nicht verändert werden.
Ich hoffe, dass Ihr mit meiner Erklärung klarkommt und wisst was ich meine.
folgend der Code zum Speichern und drucken vllt. könnt Ihr den gebrauchen.
Danke im voraus
Frank


Private Sub CommandButton1_Click()
End Sub


Private Sub CommandButton2_Click()
Const SpeicherPfad = "D:\Rapporte\"
Const bytSek As Byte = 1 'Anzahl Sekunden
Dim strFileName As String
Dim objWSH As Object
Dim intMeldung As Integer
If Range("Z5") = "" Then
MsgBox "Bitte Feld Bemerkungen prüfen"
Else
strFileName = SpeicherPfad & Range("C6") & Range("D6") & "-" & _
Range("F9") & "-" & Range("Q6") & ".xls"
ActiveWorkbook.SaveAs strFileName
'Für die Meldungsbox
Set objWSH = CreateObject("WScript.Shell")
intMeldung = objWSH.Popup("", bytSek, "Datei gespeichert unter " & strFileName)
Set objWSH = Nothing
End If
End Sub


Private Sub Drucken_Click()
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim NrAlt As Long, NrNeu As Long, wbTemplate As Workbook Dim strTemplate As String, strPfadVorlage As String ' MsgBox "Pfad: " & ActiveWorkbook.Path 'Testzeile If ActiveWorkbook.Path = "" Then 'Datei wurde noch nicht gespeichert 'Verzeichnis mit der Vorlage ' strPfadVorlage = "C:\Lokale Daten\lokalevorlagen\" 'oder wenn Vorlage im Vorlagen-Verzeichnis abgelegt strPfadVorlage = Application.TemplatesPath 'oder wenn Vorlage in einem Unterverzeichnis des Vorlagen-Verzeichnis ' strPfadVorlage = Application.TemplatesPath & "Excel\" 'Name der Musterdatei strTemplate = "MusterDatei_SerienNummer.xlt" 'letzte Seriennummer auslesen NrAlt = Me.Worksheets(1).Range("F2").Value NrNeu = NrAlt + 1 ' MsgBox "Neue Datei" 'Testzeile 'neue Nr. eintragen Me.Worksheets(1).Range("F2").Value = NrNeu 'Vorlagen Datei öffnen Application.ScreenUpdating = False Application.EnableEvents = False Set wbTemplate = Application.Workbooks.Open(Filename:=strPfadVorlage & strTemplate) 'Neue Nr. im Template eintragen wbTemplate.Worksheets(1).Range("F2").Value = NrNeu Application.DisplayAlerts = False 'Datei wieder als Template speichern wbTemplate.SaveAs Filename:=strPfadVorlage & strTemplate, FileFormat:=xlTemplate Application.DisplayAlerts = True wbTemplate.Close Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

Private Sub Workbook_Open() Dim NrAlt As Long, NrNeu As Long, wbTemplate As Workbook Dim strTemplate As String, strPfadVorlage As String ' MsgBox "Pfad: " & ActiveWorkbook.Path 'Testzeile If ActiveWorkbook.Path = "D:\Mannheim\Selleng\Mannheim\Rapporte\" Then 'Datei wurde noch _ nicht gespeichert 'Verzeichnis mit der Vorlage strPfadVorlage = "D:\Mannheim\Selleng\Mannheim\Rapporte\" 'oder wenn Vorlage im Vorlagen-Verzeichnis abgelegt 'strPfadVorlage = Application.TemplatesPath 'oder wenn Vorlage in einem Unterverzeichnis des Vorlagen-Verzeichnis ' strPfadVorlage = Application.TemplatesPath & "Excel\" 'Name der Musterdatei strTemplate = "Vorlage.xlt" 'letzte Seriennummer auslesen NrAlt = Me.Worksheets(2).Range("F9").Value NrNeu = NrAlt + 1 ' MsgBox "Neue Datei" 'Testzeile 'neue Nr. eintragen Me.Worksheets(2).Range("F9").Value = NrNeu 'Vorlagen Datei öffnen Application.ScreenUpdating = False Application.EnableEvents = False Set wbTemplate = Application.Workbooks.Open(Filename:=strPfadVorlage & strTemplate) 'Neue Nr. im Template eintragen wbTemplate.Worksheets(2).Range("F9").Value = NrNeu Application.DisplayAlerts = False 'Datei wieder als Template speichern wbTemplate.SaveAs Filename:=strPfadVorlage & strTemplate, FileFormat:=xlTemplate Application.DisplayAlerts = True wbTemplate.Close Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

Private Sub Workbook_Open() Dim NrAlt As Long, NrNeu As Long, wbTemplate As Workbook Dim strTemplate As String, strPfadVorlage As String strTemplate = "MusterDatei_SerienNummer.xlt" If LCase(ActiveWorkbook.Name) = LCase(strTemplate) Then 'Template wurde geöffnet Set wbTemplate = ActiveWorkbook NrAlt = Me.Worksheets(1).Range("F2").Value NrNeu = NrAlt + 1 'Neue Nr. im Template eintragen wbTemplate.Worksheets(1).Range("F2").Value = NrNeu Application.EnableEvents = False Application.DisplayAlerts = False 'Datei wieder speichern wbTemplate.Save Application.DisplayAlerts = True Application.EnableEvents = True End If End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

245 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

laufende Nummer vergeben

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

245 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread