Mist! Immer wieder dieselben Fehler!!!
09.11.2003 15:37:45
Franz W.
Hallo Rainer,
vielen Dank!! Jetzt, wo Du's schreibst, ist es mir klar. Aber selber komm ich mal wieder nicht drauf. Ärgerlich!!
Vielen Dank auf jeden Fall
Darf ich Dir bitte OFF TOPIC ausnahmsweise noch eine weitere Frage stellen? Wenn Du das als ungehörig empfindest, dann lies einfach nicht mehr weiter, ist auch okay.
Falls ja: Ich konnte dies vor einiger Zeit hier nicht klären, konnte mir auch keiner weiterhelfen. Es geht um folgenden Code (zufälligerweise derselbe für den auch meine obige Frage war), Du brauchst ihn nicht ganz durchzufieseln, ich geb unten schon noch an, wo es hakt:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Call UebertragSpeichern
Dim Wb As Workbook, sWb As Variant
Dim Found As Range, sSearch$
Dim loletzte& '(As Long)
Dim ReNr$, ReDatum As Date, AuftrNr$, AblDatum As Date, _
KdNr$, KdTitel$, KdTiNName$, KdNName$, KdVName$, Betrag@, ZZiel As Date
Dim jZahl%, quartZahl%
With ThisWorkbook.Worksheets("Quartalsrechnung")
jZahl = .[F13]
quartZahl = .[G13]
ReNr = .[H8]
ReDatum = .[H7]
KdNr = .Cells(9, 8)
AblDatum = .[H10]
KdTitel = .[C6]
KdNName = .[D6]
KdTiNName = .[D6] & ", " & .[C6]
KdVName = .[E6]
Betrag = .[H28]
ZZiel = .[J8]
End With
Application.ScreenUpdating = False
''' Prüfen ob "RECHNUNGEN_EH.xls" schon offen
On Error Resume Next
Set sWb = Workbooks("RECHNUNGEN_EH.xls")
If Not IsObject(sWb) Then Workbooks.Open _
Filename:="C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\RECHNUNGEN_EH.xls"
On Error GoTo 0
''' Prüfen ob Rechnungsnummer schon vorhanden
sSearch = ReNr
With Workbooks("RECHNUNGEN_EH.xls").Worksheets("Offene")
' .Activate
.Unprotect
If .Range("A65536") = "" Then loletzte = .Range("A65536").End(xlUp).Row Else loletzte = 65536
Set Found = .Range("A3:A" & loletzte).Find(sSearch, LookIn:=xlValues)
If Not Found Is Nothing Then ' Re-Nr schon vorhanden: Werte überschreiben
With .Range(Found.Address)
.Offset(0, 1) = ReDatum
.Offset(0, 2) = KdNr
.Offset(0, 3) = AblDatum
.Offset(0, 4) = KdTiNName
.Offset(0, 5) = KdVName
.Offset(0, 6) = Betrag
.Offset(0, 7) = ZZiel
'## Mit "Replace" die Punkte verschwinden lassen, damit sie nicht im Dateinnamen drin sind:
KdTitel = Replace(KdTitel, ".", "")
KdNName = Replace(KdNName, ".", "")
KdVName = Replace(KdVName, ".", "")
.Hyperlinks.Add Anchor:=.Offset(0, 10), Address:= _
"C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\" _
& jZahl & "\Quartalsrechnungen" & jZahl & "-" & quartZahl & "\" & _
ReNr & " " & KdNr & " " & KdNName & " " & KdVName & " " & KdTitel & ".xls", _
TextToDisplay:="zur Quartalsrechnung"
End With
Else ' Re-Nr noch nicht vorhanden: neue Zeile anlegen
loletzte = loletzte + 1
.Cells(loletzte, 1) = ReNr
.Cells(loletzte, 2) = ReDatum
.Cells(loletzte, 3) = KdNr
.Cells(loletzte, 4) = AblDatum
.Cells(loletzte, 5) = KdTiNName
.Cells(loletzte, 6) = KdVName
.Cells(loletzte, 7) = Betrag
.Cells(loletzte, 8) = ZZiel
.Cells(loletzte, 9).Validation.Delete
.Cells(loletzte, 9).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="bar/Kasse,Münchner Bank,Postbank,Verrechnungskonto"
.Cells(loletzte, 9).Validation.IgnoreBlank = True
.Cells(loletzte, 9).Validation.InCellDropdown = True
.Cells(loletzte, 9).Validation.InputTitle = ""
.Cells(loletzte, 9).Validation.ErrorTitle = ""
.Cells(loletzte, 9).Validation.InputMessage = ""
.Cells(loletzte, 9).Validation.ErrorMessage = ""
.Cells(loletzte, 9).Validation.ShowInput = True
.Cells(loletzte, 9).Validation.ShowError = True
'## Mit "Replace" die Punkte verschwinden lassen, damit sie nicht im Dateinnamen drin sind:
KdTitel = Replace(KdTitel, ".", "")
KdNName = Replace(KdNName, ".", "")
KdVName = Replace(KdVName, ".", "")
.Hyperlinks.Add Anchor:=.Cells(loletzte, 11), Address:= _
"C:\Dokumente und Einstellungen\bernhard\Eigene Dateien\ENERGIE_HAUSGEMACHT\RechnungenEH\" _
& jZahl & "\Quartalsrechnungen" & jZahl & "-" & quartZahl & "\" & _
ReNr & " " & KdNr & " " & KdNName & " " & KdVName & " " & KdTitel & ".xls", _
TextToDisplay:="zur Quartalsrechnung"
End If
.Protect
End With
Workbooks("RECHNUNGEN_EH.xls").Save
'Workbooks("RECHNUNGEN_EH.xls").Close SaveChanges:=True
End Sub
Dieser Code klappt einwandfrei, wenn ich HÄNDISCH die Datei schließe, dann tut er genau, was er tun soll!
Allerdings wird der Code aus einer anderen Datei heraus aufgerufen und dann werden nur Teile des Codes ausgeführt, folgende Teile überspringt er, führt sie einfach nicht aus:
- .Unprotect : er hebt den Blattschutz nicht auf
- Set Found = .Range("A3:A" & loletzte).Find(sSearch, LookIn:=xlValues) : diese ZEile übergeht er, er macht immer nur den Teil ab "Else". Im Direktfenster gibt er Found immer mit "0" an.
- am Ende dann übergeht er das Protect und das Speichern der Datei.
Gibt es dafür eine Erklärung oder ist das ein Bug.
Bitte: Antworte bitte nur, falls Du aus dem Ärmel eine Idee hast! Ich hab für mich inzwischen ein Umweg gefunden, mit dem ich das Problem umgehen kann. Hätt mich für die Zukunft nur interessiert, was ich das falsch gemacht habe oder worauf es zu achten gilt. Aber falls der Aufwand zu groß ist, lass es bitte bleiben, es besteht nicht die Notwendigkeit, das jetzt nachzubauen!
Vielen Dank und beste Grüße
Franz