AW: Rechnungsnummer Prüfen ob schon vorhanden ist
02.09.2012 09:25:16
fcs
Hallo Andi,
die Prüfung der Nummer hast du ja schon eingebaut. Allerdings nicht vor dem Drucken, sondern vor dem Archivieren.
Du muss also "nur" die Logik ein wenig anpassen.
Ich finde es alledings gewöhnungsbedürftig, dass die Rechnungsnummer, die gedruckt wird, erst unmittelbar vor dem Drucken berechnet wird.
Ich würde in Zelle E6 des Blatts "Rechnung" die Formel ändern in: =Stammdaten!H39 (nächste Rechnungsnummer)
und im Makro den Zählwert in Rechnung!I2 erst nach dem Archivieren der Rechnung um 1 erhöhen
Gruß
Franz
Private Sub CommandButton1_Click()
Dim freeR As Long ' besser Long als Integer
If ActiveSheet.Name "Rechnung" Then Exit Sub
' Fehlerhinweis beim Kopieren in Rechnungsverwaltung,
' wenn kein Endbetrag eingetragen wurde()
If Range("A11") = "" Then 'Zelle Kunden Adresse
MsgBox "Bitte Kunden auswählen"
UserForm1.Show
Exit Sub
End If
If Range("E41") = "0" Then
MsgBox "Achtung kein Endbetrag vorhanden!" & vbLf & _
"Rechnung kann nicht in Rechnungsverwaltung abgelegt werden." & vbLf & _
"Bitte einen Betrag eingeben"
'Courser startet nach abfrage in Celle A22
Range("A22").Select
Exit Sub
End If
' Rechnungs-Nr um eins hoch zählen
Sheets("Rechnung").Select
[I2] = [I2] + 1
' Rechnungsnummer prüfen
With Worksheets("Rechnungsverwaltung")
If Application.WorksheetFunction.CountIf(.Range("c2:c" _
& .Range("A65536").End(xlUp).Row), Worksheets("Rechnung").Range("E6")) > 0 Then
MsgBox "Achtung Rechnung ist bereits vorhanden! Bitte Rechnungsnummer Prüfen"
Exit Sub
End If
End With
'Rechnung drucken
ActiveWindow.SelectedSheets.PrintOut _
Copies:=2, Collate:=True 'Drucken
'Rechnung in Rechnungsverwaltung Kopieren
With Worksheets("Rechnungsverwaltung")
LoLetzte = .Range("a65536").End(xlUp).Row + 1
.Cells(LoLetzte, 1) = Worksheets("Rechnung").Range("E7") 'Kundennummer
.Cells(LoLetzte, 2) = Worksheets("Rechnung").Range("A11") 'Kunde
.Cells(LoLetzte, 3) = Worksheets("Rechnung").Range("E6") 'Rechnungsnummer
.Cells(LoLetzte, 4) = Worksheets("Rechnung").Range("E5") 'Rechnungs Datum
.Cells(LoLetzte, 5) = Worksheets("Rechnung").Range("E41") 'Rechnungsbetrag Brutto
.Cells(LoLetzte, 6) = Worksheets("Stammdaten").Range("C37") 'Zahlungs Tage
.Cells(LoLetzte, 7) = Worksheets("Stammdaten").Range("F37") 'Zahlungs Ziehl Datum
Sheets("Rechnung").Select
End With
'Rechnung Speichern
ChDir "C:\Rechnungs Backup\"
ActiveSheet.Copy
DName = [A11] & "__" & [L1] & "__" & Format([E6], "hh-mm-ss") & ".xls"
ActiveWorkbook.SaveAs DName
ActiveWorkbook.Close
MsgBox "Rechnung wurde erfolgreich Archiviert und Kopiert! Ihre Rechnungs Kopien wurden im _
Verzeichniss C:\Rechnungs Backup Ordner! Gespeichert"
Sheets("Rechnungsverwaltung").Select
End Sub