Mehrere Rechnungspositionen in eine Rechnung
19.07.2017 16:10:27
Marcus
ich wende mich an Euch/Sie, da ich folgendes Problem zu bewältigen habe:
Ich bekomme Rechnungsrohdaten von einer Firma mit Rechnungsinformationen ihrer Kunden wie Debitorennummer, Rechnungsnummer, Rechnungsdatum und natürlich dem Rechnungsbetrag. Aus diesen sollen dann die Rechnungen erstellt werden.
Nun habe ich bereits eine Excel Datei, die mit Hilfe von Makros aus jeder Zeile dieser Rohdaten eine Rechnung als neues Blatt erstellt (Ein vorgefertigtes Rechnungsformular als Template in der gleichen Excel Datei ist hier die Basis).
Dies bedeutet aber, dass für den gleichen Debitor für jeden einzelnen Posten eine separate Rechnung erstellt wird (so. z.B. 10 Rechnung über je 3 Euro). Ziel wäre es nun, dass für einen Debitor jeweils nur eine einzige Rechnung, mit allen seinen offenen Positionen darin, erstellt wird.
Ich schätze, dass hier im existierenden Code ein Loop eingebaut werden müsste, der das Dokument nach gleichlautenden Debitorennummern checkt und diese Werte dann in einer einzelnen Rechnung ausgibt, bevor er ein neues Blatt/eine neue Rechnung erstellt.
Ein damit zusammenhängendes Problem wäre dazu, dass jede einzelne Zeile in den Rohdaten eine separate Rechnungsnummer hat und somit nicht in der Rechnungsüberschrift auftauchen kann (wie momentan programmiert) sondern jeweils hinter der zugehörigen Position auftauchen muss.
Dies ist der aktuelle Code hinter dem Button: "Create Invoice":
Sub Button1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim c As Range, Myrange As Range
Sheets("Invoice Overview").Select
Set Myrange = Sheets("Invoice Overview").Range("B9:B" & Sheets("Invoice Overview").Cells( _
Rows.Count, 2).End(xlUp).Row)
For Each c In Myrange
Dim sCheck As Boolean
sCheck = False
With ThisWorkbook
For sheet_loop = 1 To .Sheets.Count
If .Sheets(sheet_loop).Name = c.Value Then
sCheck = True
Exit For
End If
Next sheet_loop
End With
If sCheck = False Then
c.Select
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = c.Value
Sheets("Template").Cells.Copy
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Sheets("Invoice Overview").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=c.Value & "!A1", _
TextToDisplay:=c.Value
End If
Next c
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
VG
Marcus
Anzeige