Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1228to1232
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
Inhaltsverzeichnis

Systemfehler bei Mappenschließung

Systemfehler bei Mappenschließung
Reinhard
Hallo Wissende,
Code könnte ich schon zeigen, einaml relativ wenig Code, Problem ist der funktioniert ja, oder viel Code der nicht funktioniert.
Im Blatt1 der beiden angehängten Mappen habe ich eine Schaltfläche "Konfiguration".
Klickt man darauf so hat man nach einer PW-Abfrage, (Passwort ist "imark"),
und zwei Nachfragen die man mit Ja- Anklicken beanwortet zwei offene Mappen.
Einmal eine deren name der name der Originalmappe ist plus datumszusatz und eine mappe die "Neuemappe.xls" heißt. Das ist alles in Ordnung und so angedacht.
"Neuemappe.xls" kann man problemlos schließen.
Aber bei der anderen Mappe (die mit dem datumszusatz) kommen dreimal nacheinander Fensterchen mit dieser Meldung:
Userbild
Hier die Originalmappe wo der Fehler beim Schliessen dann kommt:
http://www.uploadagent.de/show-177508-1315923504.html
Und hier die Mappe wo es funktioniert beim Schliessen:
http://www.uploadagent.de/show-177509-1315923616.html
In der Bedienung beider Mappen gibt es nur einen Unterschied, in der fehlerhaften ersten mappe muß man erst di erscheinende UF wegklicken mit dem Schließkreuz der UF.
Danach bei beiden gleich, oben auf Konfugiration klicken, Passwort imark, zweimal ja sagen.
Der Unterschied zeigt sich wenn man die erste Mappe schließen will, dann kommt der Fehler.
In der zweiten Mappe habe ich alles an Code rausgeworfen was ich für den Ablauf "hinter" dem Button "Konfigaration" nicht brauche.
Wenn das jetzt eine zu heftige Anfrage für ein Forum ist weil es viel Code ist, ich freue ich mich auch über alle Tipps/Ideen wie ich da dem Problem bzw. der problemlösung auf die Spur kommen könnte.
Oder auch Mutmaßungen, Wissen was da in der Fehlermeldund "falsche Parameter bedeutet.
Danke ^ Gruß
Reinhard

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
ExcelAbsturz bei SaveCopyAs
15.09.2011 09:17:16
Reinhard
Hallo Wissende,
https://www.herber.de/bbs/user/76624.xls
ich habe jetzt den Code zusammengestrichen, es ist nur noch der nachstehende Code in der Mappe.
Die MsgBox wird noch ausgeführt. Dann bei Ausführung von
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & "NeueMappex" & Endung
ist Excel verschwunden und Win fragt mich ob ich Problembericht senden will :-(
Davor die Codezeile:
ThisWorkbook.SaveCopyAs Dateiname & Format(Date, "yyyy-mm-dd") & Endung
wird problemlos ausgeführt.
Ich bin ratlos.
Gruß
Reinhard
Im Standardmodul Modul3:

Sub Konfiguration()
Konfig.Show 0
End Sub
In der Userform Konfig:

Private Sub Neuer_Monat_Click()
Dim Dateiname As String, Endung As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Unload Konfig
Endung = Mid(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "."))
Dateiname = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, ".") - 1)
ThisWorkbook.SaveCopyAs Dateiname & Format(Date, "yyyy-mm-dd") & Endung
If Dir(ThisWorkbook.Path & "\" & "NeueMappex" & Endung)  "" Then
Kill ThisWorkbook.Path & "\" & "NeueMappex" & Endung
End If
'MsgBox "-" & ThisWorkbook.Path & "\" & "NeueMappex" & Endung & "-"
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & "NeueMappex" & Endung
'Workbooks.Open ThisWorkbook.Path & "\" & "NeueMappex" & Endung
End Sub

Anzeige
XL 200X Tester gesucht :-)
15.09.2011 09:27:03
Reinhard
Hallo Wissende,
in XL2007 tritt der Fehler nicht auf, Code läuft problemlos durch.
Nun weiß ich nicht ob mein XL 2000 defekt ist oder ob es bei allen XL 2000 Benutzern auftritt.
Ich würde mich freuen wenn es jmd. mit XL 2000 testen und mich informieren würde.
Desgleichen aus Interesse bei XL 2002 und XL 2003
Dankeschön
Gruß
Reinhard
Code läuft in XL2003...
16.09.2011 12:34:39
silex1
Hallo Reinhard,
Code läuft unter XL2003 (11.8335.8333) SP3
Hatte auch mal gelesen...dass es teilweise auch an den Versionsnummern liegt. Ob dass jedoch für den Code zutrifft, kann ich nicht beurteilen!
VG René
AW: XL 200X Tester gesucht :-)
16.09.2011 12:50:37
fcs
Hallo Reinhard,
hab die älteren Versionen von Excel nicht, nur Excel 98, welches aber schon an InstrRev scheitert.
Der Kill-Teil ist eigentlich nicht nötig. SaveCopyAs bügelt seine Kopie ohne Rückfrage über eine vorhandene Datei.
Ich würde die Unload-Anweisung an das Ende stellen.
Gruß
Franz

Private Sub Neuer_Monat_Click()
Dim Dateiname As String, Endung As String
Application.EnableEvents = False
Me.Hide
Endung = Mid(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "."))
Dateiname = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, ".") - 1)
Dateiname = Dateiname & Format(Date, "yyyy-mm-dd") & Endung
ThisWorkbook.SaveCopyAs Dateiname
MsgBox "-" & Dateiname & "-"
Dateiname = ThisWorkbook.Path & "\" & "NeueMappex" & Endung
ThisWorkbook.SaveCopyAs Dateiname
MsgBox "-" & Dateiname & "-"
Workbooks.Open Dateiname
Application.EnableEvents = True
Unload Konfig
End Sub

Anzeige
AW: XL 200X Tester gesucht :-)
16.09.2011 22:15:16
Reinhard
Hallo Franz, Renè,
danke für eure Gedanken und Mühe.
@Renè, da es in meinem XL 2007 lief dachte ich mir schon daß es auch in XL 2003 laufen würde, danke für die Bestätigung.
@Franz, ja das mit dem Kill ist unnötig, baute ich aus Verzweiflung ein :-( Ich wollte sicherer als sicher gehen daß von dieser Seite kein Problem kommt.
Selbstverständlich teste ich deinen Code. Vielleicht ist er ja die Lösung für XL 2000, denn in XL 2007 und XL 2003 läuft erja.
Zu Instrrev in XL 97, schau mal den nachfolgenden Code, den hab ich mir mal aus Fundstücken zusammengebastelt. Vielleicht kannste ja damit was anfangen wenn du überhaupt noch mit XL 97 arbeitest.
Die Frage im Code:
As VbCompareMethod" wird nicht akzeptiert, fehlt da ein Verweis?
ist von mir. Wenn du es auswendig weist was da zu tun wäre so ist es gut. Ansonsten investiere bitte keine Mühe, ich hab den Code schon jahrelang nicht mehr genützt und sehe da auch in der Zukunft keinen Verwendungszweck.
Andrerseits bin ich immer sehr interessiert daran herauszufinden welchen Verweis denn Excel will wenn es da was bemängelt.
Ideal wäre für mich irgendeine Liste. Wo stünde

Deklarationstyp   nötiger Verweis
DataObject                    MS Forms 2.0
VbCompareMethod       ?

Gruß
Reinhard

Option Explicit
Private Declare Sub PokeLng Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal Addr As Long, Value As Long, Optional ByVal Bytes As Long = 4)
Sub Test_InstrRev()
Dim Position As Integer
Rows("5:1000").ClearContents
Position = InStrRev(Range("B4").Value, Range("B3").Value)
Cells(6, 1) = "Position:"
Cells(6, 2) = Position
End Sub
'VB5 bietet von Haus aus keine Rückwärts-Suche innerhalb von Strings an.
'Die folgende Routine implementiert daher die seit VB6 bekannte Funktion
'und ist (dank binärer Suche) oft sogar schneller:
Public Function InStrRev(ByRef sCheck As String, ByRef sMatch As String, _
Optional ByVal Start As Long, Optional ByVal Compare = vbBinaryCompare) As Long
'( "As VbCompareMethod" wird nicht akzeptiert, fehlt da ein Verweis? )
'Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
'© Jost Schwider, 29.10.2000-17.12.2000 - http://vb-tec. _
de/instrrev.htm
Dim Stopp As Long, Index As Long, Pivot As Long, Length As Long
Dim LengthPtr As Long, MatchLen As Long
#If VBA6  0 Then  ' =XL97, VBA6 gibt es ab XL2000, vorher war es VBA5 bei XL97
InStrRev = VBA.InStrRev(sCheck, sMatch)
Exit Function
#End If
If Compare = vbBinaryCompare Then
MatchLen = LenB(sMatch) - 1
If MatchLen > -1 Then
'Linke Grenze bestimmen:
Stopp = InStrB(sCheck, sMatch)
If Stopp = 0 Then Exit Function
'Rechte Grenze bestimmen:
Length = LenB(sCheck)
If Start  Start Then Exit Function
LengthPtr = StrPtr(sCheck) - 4
PokeLng LengthPtr, Start + MatchLen
End If
'Ersten Treffer merken:
InStrRev = Stopp
Stopp = Stopp + 2
'Binäre Suche / Intervall-Halbierungs-Verfahren:
Do
'Ab Mitte testen:
Pivot = (Stopp + Start) \ 2
Index = InStrB(Pivot, sCheck, sMatch)
'Treffer?
If Index Then
InStrRev = Index
If Index >= Start Then
PokeLng LengthPtr, Length
InStrRev = InStrRev \ 2 + 1
Exit Function
End If
Stopp = Index + 2
Else
If Stopp + 8 >= Pivot Then Exit Do
Start = Pivot - 1
PokeLng LengthPtr, Start + MatchLen
End If
Loop
'Konventionell weiter machen:
Index = InStrB(Stopp, sCheck, sMatch)
Do While Index
InStrRev = Index
Index = InStrB(Index + 2, sCheck, sMatch)
Loop
InStrRev = InStrRev \ 2 + 1
'Bei grossen Zeichenketten könnte es passieren, dass der hintere Bereich
'mehrmals durchsucht werden müßte. Daher wird der String intern
'(durch temporäres Patchen der Längenangabe) gekürzt.
'So müssen bereits durchsuchte Bereiche nicht nochmal durchlaufen werden.
'Dies geschieht mit Hilfe obiger API-Deklaration
PokeLng LengthPtr, Length
Else
If Start 

Anzeige
AW: InStrRev für Excel 97
17.09.2011 09:03:39
fcs
Hallo Reinhard,
für Kompatibilität mit Excel 97 hab ich meist eine der der nachfolgenden für meine Zwecke ausreichenden benutzerdefinierten Excel-Funktionen verwendet.
As VbCompareMethod unter XL 97
Diesen Typ gab es unter XL 97 wahrscheinlich noch nicht. Hier einfach As Long oder As Integer verwenden.
Zur Kompatibilität mit älteren Excel-Versionen sollte man nicht mit den VBA-Konstanten arbeiten, sondern die entsprechenden Werte einsetzen; z.B.:
vbBinaryCompare = 0
vbTextCompare = 1
Auch "Option Explicit" muss man ggf. weglassen, damit Methoden/Eigenschaften der neueren Excelversionen nicht als Fehler angezeigt werden.
Gruß
Franz

Public Function InstrRev_xl97(ByVal sText As String, ByVal sFind As String, _
Optional ByVal lngStart As Long = -1, _
Optional ByVal boolGrossKlein As Boolean = True) As Long
'Zeichensuche von rechts
Dim lngPos As Long
Dim sString As String, sSearch As String
If sText = "" Or sFind = "" Then Exit Function
sString = sText: sSearch = sFind
If boolGrossKlein = False Then
sString = UCase(sString): sSearch = UCase(sSearch)
End If
If lngStart = -1 Then
ElseIf lngStart > 0 Then
sString = Left(sString, lngStart)
Else
Exit Function
End If
If InStr(1, sString, sSearch) = 0 Then Exit Function
For lngPos = Len(sString) - Len(sSearch) + 1 To 1 Step -1
If Mid(sString, lngPos, Len(sSearch)) = sSearch Then
InstrRev_xl97 = lngPos
Exit For
End If
Next
End Function
Public Function InstrRev_xl97s(ByVal sText As String, ByVal sFind As String) As Long
'Zeichensuche von rechts - vereinfacht
Dim lngPos As Long
Dim sString As String, sSearch As String
If sText = "" Or sFind = "" Then Exit Function
For lngPos = Len(sText) - Len(sFind) + 1 To 1 Step -1
If Mid(sText, lngPos, Len(sFind)) = sFind Then
InstrRev_xl97s = lngPos
Exit For
End If
Next
End Function

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige