Rechnungsnummern erstellen

Hallo allerseits,
ich arbeite derzeit eine eine Massengenerierung von manuellen Rechnungsdokumenten anhand einer tabellarischen Aufstellung. Bis hierhin auch soweit ganz gut.
Jetzt arbeite ich derzeit an eine automatischen Generierung von Rechnungsnummern für die jeweiligen Dokumente, das klappt auch. Jedoch möchte ich, wenn der Buchungskreis in Spalte "intColBUKRS" wechselt, dass der Zähler auch wieder von 1 beginnt. Bisher werden mit fortlaufende Nummer (ungeachtet vom Buchungskreis) erstellt. Ich habe jetzt schon Einiges durch experimentiert, aber ohne Erfolg. Hat jemand eine Idee wie ich es besser machen kann. Für Eure Hilfe bin ich Euch sehr dankbar.


Option Explicit
Private intColBUKRS As Integer
Private intColInvPos As Integer
Private intColXBLNR As Integer
Private lo As ListObject
Private Sub InvNo()
Dim ws As Worksheet
Dim intRowNo As Integer
Dim intInvNo As Integer
Dim intYear As Integer
Dim intCC As Integer
Set ws = shAufstellung
Set lo = ws.ListObjects("tblSource")
intColBUKRS = GetHeaderColumn("Company Code")
intColInvPos = GetHeaderColumn("Invoice position")
intColXBLNR = GetHeaderColumn("Reference")
intYear = ActiveWorkbook.BuiltinDocumentProperties(6)
intInvNo = ActiveWorkbook.BuiltinDocumentProperties(5)
Application.ScreenUpdating = False
On Error Resume Next
If intYear  Year(Date) Then
intInvNo = 0
intYear = Year(Date)
ActiveWorkbook.BuiltinDocumentProperties(6) = intYear
End If
For intRowNo = 1 To lo.DataBodyRange.Rows.Count
intCC = lo.DataBodyRange(intRowNo, intColBUKRS)
If lo.DataBodyRange(intRowNo, 2).Text  "No" _
And lo.DataBodyRange(intRowNo, intColInvPos).Value = 1 _
Then
intInvNo = intInvNo + 1
ActiveWorkbook.BuiltinDocumentProperties(5) = intInvNo
lo.DataBodyRange(intRowNo, intColXBLNR) = intCC & intYear & Format(intInvNo, "0000")
Else:
If lo.DataBodyRange(intRowNo, 2).Text  "No" _
And lo.DataBodyRange(intRowNo, intColInvPos).Value  1 _
And lo.DataBodyRange(intRowNo, intColXBLNR).Value = "" _
Then
lo.DataBodyRange(intRowNo, intColXBLNR).Value = lo.DataBodyRange(intRowNo - 1, intColXBLNR).Value
End If
End If
Next intRowNo
Err.Clear
Application.ScreenUpdating = True
End Sub
'get header column
Private Function GetHeaderColumn(ByVal strHeader As String)
Dim i As Integer
Set lo = shAufstellung.ListObjects("tblSource")
For i = 1 To lo.ListColumns.Count
If UCase(lo.HeaderRowRange.Columns(i)) = UCase(strHeader) Then
GetHeaderColumn = lo.HeaderRowRange.Columns(i).Column
Exit Function
End If
Next i
'not found, return 0, leads to an error
GetHeaderColumn = 0
End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub InvNo() Dim ws As Worksheet Dim intRowNo As Integer Dim intInvNo As Integer Dim intYear As Integer Dim intCC As Integer Dim dicInvNos As Object Set dicInvNos = CreateObject("Scripting.Dictionary") Set ws = shAufstellung Set lo = ws.ListObjects("tblSource") intColBUKRS = GetHeaderColumn("Company Code") intColInvPos = GetHeaderColumn("Invoice position") intColXBLNR = GetHeaderColumn("Reference") intYear = ActiveWorkbook.BuiltinDocumentProperties(6) Application.ScreenUpdating = False On Error Resume Next If intYear Year(Date) Then 'initialisiere den Zähler für alle Buchungskreise For Each intCC In lo.DataBodyRange.Columns(intColBUKRS).Value If Not dicInvNos.Exists(intCC) Then dicInvNos.Add intCC, 0 End If Next intYear = Year(Date) ActiveWorkbook.BuiltinDocumentProperties(6) = intYear End If For intRowNo = 1 To lo.DataBodyRange.Rows.Count intCC = lo.DataBodyRange(intRowNo, intColBUKRS) If lo.DataBodyRange(intRowNo, 2).Text "No" _ And lo.DataBodyRange(intRowNo, intColInvPos).Value = 1 _ Then 'verwende den Zähler für den aktuellen Buchungskreis intInvNo = dicInvNos(intCC) + 1 dicInvNos(intCC) = intInvNo lo.DataBodyRange(intRowNo, intColXBLNR) = intCC & intYear & Format(intInvNo, "0000") Else: If lo.DataBodyRange(intRowNo, 2).Text "No" _ And lo.DataBodyRange(intRowNo, intColInvPos).Value 1 _ And lo.DataBodyRange(intRowNo, intColXBLNR).Value = "" _ Then lo.DataBodyRange(intRowNo, intColXBLNR).Value = lo.DataBodyRange(intRowNo - 1, intColXBLNR).Value End If End If Next intRowNo Err.Clear Application.ScreenUpdating = True End Sub

Hallo Steffen,
vielen Dank für die Zeit, die Du Dir genommen hast, um mein Problem zu lösen.
Auf die Idee, ein Dictionary zu schreiben, bin ich nicht gekommen, bzw. soweit bin ich leider noch nicht in VBA.
Dein Code funktioniert auch bestens, jedoch habe ich noch nicht herausgefunden, wie dieser den Wert im folgenden Monat erhöhen würde, ausgehend von der letzmaligen vergebenen Nummer innerhalb des Buchungskreises. Auf Basis dieser Tabelle soll ein Rechnungsformular erstellt werden und im Idealfall soll erst die Nummer vergeben werden, wenn diese dazugehörige Rechnung als pdf abgespeichert wird und im Folgemonat bei Ausführung des Codes die Nummernfolge erhöhen.
Hast Du hierzu noch einen Tipp für mich? Muss ich hierzu das Workbook_BeforeSave Event verwenden?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim intYear As Integer intYear = ActiveWorkbook.BuiltinDocumentProperties(6) If intYear Year(Date) Then ResetInvoiceNumbers intYear End If End Sub Private Sub ResetInvoiceNumbers(intYear As Integer) Dim ws As Worksheet Dim lo As ListObject Dim intColBUKRS As Integer Dim dicInvNos As Object Set ws = shAufstellung Set lo = ws.ListObjects("tblSource") intColBUKRS = GetHeaderColumn("Company Code") Set dicInvNos = CreateObject("Scripting.Dictionary") 'initialisiere den Zähler für alle Buchungskreise InitializeInvoiceNumbers lo, intColBUKRS, dicInvNos 'aktualisiere das aktuelle Jahr im Workbook-Property ActiveWorkbook.BuiltinDocumentProperties(6) = Year(Date) End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread