über WORKBOOK_Open lasse ich eine automatische Rechnungsnummer einfügen (Code habe ich von Rainer erhalten). Bei WORKBOOK_BEFOREPRINT lasse ich dann Werte, u.a. diese Rechnungsnummer, in eine andere Tabelle = "wachsende Tabelle" eintragen. Das Problem ist aber, wenn der Anwender die Rechnung öffnet, sie dann aber wieder schließt, weil er vielleicht doch kein Bock hat, eine Rechnung zu schreiben, ist die Rechnungsnummer vergeben und in der fortlaufenden = wachsenden Tabelle, entstehen Lücken bei den Rechnungsnummern. Nun habe ich auch die Vergabe der Rechnungsnummer bei WORKBOOK_BEFOREPRINT festgelegt, aber dann funktioniert die Übertragung der Werte nicht mehr. Angefügt den "unheimlich langen" Code. Würde mich freuen, wenn Ihr mir helfen könntet.
Vielen Dank!
Cordula
Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error GoTo R_Error
Dim newNr As Variant, oldNr As Variant
Dim FileName As String
FileName = "C:\Rechnung.ini"
If Range("B14") <> "" Then Exit Sub
Close #1
restart:
Open FileName For Input As #1
Line Input #1, oldNr
Close #1
newNr = oldNr + 1
Open FileName For Output As #1
Write #1, newNr
Close #1
Select Case Len(newNr)
Case 1
newNr = "00" & newNr
Case 2
newNr = "0" & newNr
Case 3
newNr = newNr
Case 4
MsgBox "Zahlenlimit überschritten"
Exit Sub
End Select
Range("B14") = newNr & "-04 A"
R_Exit:
Exit Sub
R_Error:
Select Case Err
Case 53
Open FileName For Output As #1
Close #1
Open FileName For Output As #1
Write #1, 0
Close #1
Err.Clear
Resume restart
Case 54
Close #1
Resume restart
Case Else
MsgBox Err & ": " & Err.Description
Resume R_Exit
End Select
'folgend die Übertragung der Daten
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
chkStr = wksSource.Range("A11").Value
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 7).Value = wksSource.Range("F30").Value
wksTarget.Cells(iRow, 3).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
chkStr = Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10)))
wksTarget.Cells(iRow, 4).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
End Sub