Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
440to444
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
440to444
440to444
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

schon wieder "wachsende Tabelle"

schon wieder "wachsende Tabelle"
11.06.2004 14:20:30
Cordula
Hallo Excel-Freunde,
ü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

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: schon wieder "wachsende Tabelle"
TE
Hi Cordula,
also ich hab das bei meinen Rechnungsnummern wie folgt gelöst:
1.) Rechnungsnummerzuweisung erst nach Fertigstellung der Rechnung, nämlich auf Knopfdruck. (Dabei 1.Rechnungsnummerzuteilung und 2.Übertragung der relevanten Daten in Deine Übersichts-Datei
2.) in der Übersichtsdatei sind in Spalte A die Rechnungsnummern schon fortlaufend drin.
Bei Knopfdruck "Rechnungsnummer zuweisen" sucht das Makro nach der nächsten freien Zeile in der ÜBERSICHT.xls (also z.B. wo in Spalte B noch kein Rechnungsdatum drinsteht) und nimmt die Rechnungsnummer aus Spalte A, überträgt sie in die Rechnung und saugt anschliessend Rechnungsempfänger, Zahlungsziel, Betrag usw ausm Rechnungsformular und schreibt sie in die ÜBERSICHT.xls.
Is wohl ein ganz anderer Ansatz, aber ich finds gut so.
TE
Anzeige
leider nicht das Richtige
Cordula
Hallo TE,
"meine" Anwender sollen nicht über einen Knopfdruck die Daten übertragen etc. Denn leider vergißt es der Eine oder Andere schon einmal. Von daher muss alles automatisch erfolgen. Trotzdem vielen Dank für deinen Hinweis
LG
Cordula
Verständnisfrage
K.Rola
Hallo,
was klappt denn nicht in BeforePrint?
Was passiert eigentlich, wenn mal ein Fehldruck passiert oder kein Papier
im Drucker war oder sonst irgendein Fehler beim Drucken auftritt?
Hast du dann eine Möglichkeit, das Fortschreiben zu korrigieren/verhindern?
Überleg mal, eine Boolsche Variable in BeforePrint zu setzen, die bei erfolg-
reichem Druck z.B. auf True gesetzt wird. In WorkbookBeforeClose dann prüfen
und ggf. den Zähler aktualisieren.
Gruß K.Rola
Anzeige
AW: Verständnisfrage
Cordula
Hallo K.Rola
STIMMT! Was passiert bei Fehldruck. Habe nicht daran gedacht. Dann ist es vielleicht sinnvoll, die Vergabe der Rechnungsnummer beim Drucken zu vergeben und das Übertragen der Daten beim Schließen. Oder?
LG
Cordula
AW: Verständnisfrage
K.Rola
Hallo,
so wars gemeint. Was mir allerdings nicht klar ist, ich hab das Problem so
noch nicht gehabt und es auch noch nicht probiert, wie sich mit Sicherheit
sagen läßt, ob der Druck erfolgreich war.
Gruß K.Rola
AW: Verständnisfrage
Cordula
Hallo K.Rola
den Code für die automatische Rechnungsnummer liegt jetzt bei BEFORE_PRINT. Das klappt. Das Übertragen der Daten bei BEFORE_CLOSE klappt nicht. Möglicherweise weil ich noch einen weiteren Code eingebaut habe? Irgend etwas fehlt, ich weiß nur nicht was. Kannst du ihn dir mal angucken?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Ü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)
'hier fehlt irgendeine Anweisung! Nur welche? Die oberste letzte Zeile wird gelb unterlegt und er bringt mir Laufzeitfehler 5
On Error GoTo fehler
Workbooks("Wachsende_Tabelle.xls").Activate
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
fehler:
MsgBox "Bitte zukünftig die ""Wachsende_Tabelle"" nicht mehr manuell speichern und schließen!" & Chr(13) & _
"Die Speicherung/Schließung erfolgt automatisch mit der Schließung der Rechnung!", vbInformation, "ACHTUNG"
End Sub

LG
Cordula
Anzeige
AW: Verständnisfrage
K.Rola
Hallo,
lad doch mal was abgespecktes hoch, hab keine Lust, das nachzubauen.
Gruß K.Rola
AW: Verständnisfrage
Cordula
Hallo K.Rola,
sorry das ich so spät antworte. was meinst du mit abgespeckt?
Soo ich dir das formular mal mit dem Code per e-mail schicken?
LG
Cordula
PS: kann leider erst morgen früh wieder ins forum!
Gute Nacht!
Hallo K.Rola?
Cordula
Hallo K.Rola,
bin wieder online. Kannst du mir noch helfen?
LG
Cordula
PS: Datenübertragung klappt, die "On Error GoTo fehler" -Code aber nicht!
Habe Lösung gefunden
Cordula
Hallo K.Rola und die jenigen, die "evtl. kopfschüttelnd" mitverfolgt haben... :-))
die Lösung lag so nahe!! Mußt nur das "On Error GoTo fehler" direkt unter BeforeClose setzen!! Nu funktioniert alles! Tsssss....
Schönes Wochenende Euch allen!
LG
Cordula
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige