Sachverhalt:
In einer separaten Mappe hat es eine Lieferschein-Rechnungstabelle. Jeder Lieferschein hat eine eindeutige Nummer und einen Eintrag (Zeile). Mit einer weiteren Mappe befülle ich diese Zeilen.
Wird nun mit der 2. Mappe eine Rechnung erstellt, so suche ich in der LS-RNG-Tabelle nach der _ Lieferscheinnummer, erzeuge die nächst höhere Rechnungsnummer und trage dort zusätzlich die Rechnungsangaben ein.
Sub RNG_Übertrag_mehrfach()
Dim RNG_Firma As String
Dim RNG_Ort As String
Dim RNG_Wert As String
Dim RNG_X As String
Dim RNG_Anzahl As Byte
Dim LS_Wert As String
If ActiveSheet.Name = "Vorlage" Then
MsgBox "Lieferschein zuerst kopieren!"
Else
If ActiveSheet.Range("O2") "" Then
MsgBox "Rechnungsnummer bereits vorhanden!"
Else
If ActiveSheet.Range("M10") = "" Then
MsgBox "Keine Versandart ausgewählt! Eingabemaske starten!"
Else
If ActiveSheet.Range("M11") = "" Then
MsgBox "Anzahl Sendungen nicht bestimmt! Eingabemaske starten!"
Else
Range("M2").Select
ActiveCell.FormulaR1C1 = "x"
Range("O8").Select
Dim Aktuelles_Datum_RNG As Date
Aktuelles_Datum_RNG = Date
ActiveCell.FormulaR1C1 = Aktuelles_Datum_RNG
RNG_mehrfach_erstellen.Show
Ersteller = ActiveSheet.Range("M8").Value
Aktuelles_Datum_RNG = ActiveSheet.Range("O8").Value
Range("O8").Value = Format(Range("O8"), "dd.mm.yy")
RNG_Anzahl = ActiveSheet.Range("O12").Value
Range("A1").Select
RNG_Firma = ActiveSheet.Range("D5").Value
RNG_Name = ActiveSheet.Range("D6").Value
RNG_Ort = ActiveSheet.Range("D8").Value
LS_Wert = ActiveSheet.Range("O1").Value
'---------------------- LS-RNG-Tabelle bearbeiten ------------------------------------
Workbooks.Open Filename:= _
"O:\NeuweilerAG\Rechnungs- Lieferscheinliste\Rechnungs- Lieferscheinliste.xlsm"
ActiveSheet.Unprotect Password:="Neuwe!1er"
RNG_Wert = Application.WorksheetFunction.Max(Range("H:H")) + 1
'---------------------- Suchfunktion ------------------------------------
Dim Ergebnis As Range
Set Ergebnis = ActiveSheet.Columns(1).Find(what:=LS_Wert, lookat:=xlWhole)
Dim Aktuelles_Datum As Date
Cells(Ergebnis.Row, 8).Select
ActiveCell.FormulaR1C1 = RNG_Wert
Cells(Ergebnis.Row, 9).Select
ActiveCell.FormulaR1C1 = RNG_Firma
Cells(Ergebnis.Row, 10).Select
ActiveCell.FormulaR1C1 = RNG_Ort
Aktuelles_Datum = Date
Cells(Ergebnis.Row, 11).Select
ActiveCell.FormulaR1C1 = Aktuelles_Datum_RNG
Cells(Ergebnis.Row, 12).Select
ActiveCell.FormulaR1C1 = Ersteller
ActiveSheet.Protect Password:="Neuwe!1er"
Dim w As Workbook
Set w = ActiveWorkbook
w.CustomDocumentProperties.Add _
Name:="saveme", _
LinkToContent:=False, _
Type:=msoPropertyTypeBoolean, _
Value:=True
w.Save
ActiveWindow.Close SaveChanges = False
'---------------------- anschliessend Wert in 2. Mappe übertragen -----------------------------
Range("O2").Select
ActiveCell.FormulaR1C1 = RNG_Wert
ActiveSheet.Range("$A$17:$F$60").AutoFilter Field:=7, Criteria1:=""
Dim Blattname As String
Blattname = ActiveSheet.Name
ActiveSheet.Name = "RG " & RNG_Wert & " - " & Blattname
Dim PDF_LS As Object, MyMessage As Object
Dim PDFname As String
PDFname = "\" & ActiveSheet.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & PDFname, Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False
End If
End If
End If
End If
End Sub
Problemstellung:
Da nun aus einem Lieferschein auch mehrere Rechnung erstellt werden können (gesteuert über Formular), benötige ich eine Suchfunktion die zusätzlich überprüft, ob in der Zelle die Rechnungsnummer bereits eingetragen ist und dann je nach Fall die nächste Zeile sucht oder eben Eintragungen vornimmt.
Da der User im Vorfeld entscheiden muss ob nun der Lieferschein kopiert werden muss in folge anschliessender mehrfach Verrechnung, wird es einen Butten geben der den Lieferschein entsprechend x-mal kopieren wird bevor das Rechnungs-Makro ausgeführt wird.