Anzeige
Archiv - Navigation
1600to1604
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

Fehlerbehandlung

Fehlerbehandlung
18.01.2018 22:31:07
Ralf
Hallo,
nach vergeblicher Suche und einigen erfolglosen Versuchen hoffe ich auf Hilfe in diesem Forum. Ich möchte eine Fehlerbehandlung in den Code einbauen. Der Code funktioniert soweit und ich bin zufrieden. Jedoch können 2 Fehler auftreten welche immer dazu führen das Excel nicht mehr reagiert oder in einer Schleife landet.
Fehlerbehandlung für Fall 1: Die Quell-Datei existiert nicht.
Ist Verhalten: Excel öffnet das Fenster um die Datei manuell zu suchen
Aktion "Abbrechen" führt immer wieder zum öffnen des Datei-Suchen Fensters.
Folge: Excel muss beendet werden.
Soll Verhalten: MsgBox & Exit Sub.
Fehlerbehandlung für Fall 2: Die Quell-Datei ist durch mich geöffnet.
Ist Verhalten: Excel reagiert nicht mehr und es erscheint keine Meldung.
Folge Excel muss beendet werden.
Soll Verhalten: MsgBox & Exit Sub.
Anmerkungen: Wenn eine Datei durch anderen Benutzer geöffnet ist funktioniert der Code.
Private

Sub CommandButton2_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Jetzt aktualisieren? Die Dauer beträgt ca. 1-2 Minuten." & vbCrLf & "Nach Abschluss der  _
Aktualisierung erfolgt eine Meldung."    ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2    ' Define buttons.
Title = "Datenaktualisierung!"    ' Define title.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
MyString = "Yes"    ' Perform some action.
Else    ' User chose No.
Exit Sub 'MyString = "No" ' Perform some action.
End If
Dim R As Range
Dim ZTabelle As String, ZZelle As String
Dim QPfad As String, QDatei As String, QTabelle As String, QZelle As String
Dim Maske As String, Temp As String
'Syntax für einen Zellverweis mit Pfad auf eine externe Datei
Maske = "'@Pfad[@Datei]@Tabelle'!@Zelle"
With Sheets("Referenz")
On Error Resume Next
'Durchlaufe alle Zellen von A2 bis A?
For Each R In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
'Werte aus dieser Zeile einlesen (einfacher zu debuggen)
ZTabelle = .Range("A" & R.Row)
ZZelle = .Range("B" & R.Row)
QPfad = .Range("C" & R.Row)
QDatei = .Range("D" & R.Row)
QTabelle = .Range("E" & R.Row)
QZelle = .Range("F" & R.Row)
'Der Pfad muss einen \ am Ende haben
If Right(QPfad, 1)  "\" Then QPfad = QPfad & "\"
'Syntax-String holen und die Felder ersetzen
Temp = Maske
Temp = Replace(Temp, "@Pfad", QPfad)
Temp = Replace(Temp, "@Datei", QDatei)
Temp = Replace(Temp, "@Tabelle", QTabelle)
Temp = Replace(Temp, "@Zelle", QZelle)
'Wert einlesen
Sheets(ZTabelle).Range(ZZelle) = DDE(Temp)
Next
End With
Function DDE(ByVal Reference As String) As Variant
Static XL As Application
On Error Resume Next
'Issue: When called as UDF and Reference is a cell, Excel supress the 1st ' if any
If InStr(Reference, "'!") > 0 And Left$(Reference, 1)  "'" Then Reference = "'" &  _
Reference
If XL Is Nothing Then Set XL = CreateObject("Excel.Application")
DDE = XL.ExecuteExcel4Macro(Application.ConvertFormula(Reference, xlA1, xlR1C1, True))
End Function

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehlerbehandlung
19.01.2018 03:59:30
fcs
Hallo Ralf,
du kannst mit der Funktion Dir prüfen, ob eine Datei existiert.
Ebenso kann mn reltiv einfach prüfen, ob eine Datei lokal geöffnet ist.
Gruß
Franz

Sub CommandButton2_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Jetzt aktualisieren? Die Dauer beträgt ca. 1-2 Minuten." & vbCrLf & _
"Nach Abschluss der Aktualisierung erfolgt eine Meldung."    ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2    ' Define buttons.
Title = "Datenaktualisierung!"    ' Define title.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
MyString = "Yes"    ' Perform some action.
Else    ' User chose No.
Exit Sub 'MyString = "No" ' Perform some action.
End If
Dim R As Range
Dim ZTabelle As String, ZZelle As String
Dim QPfad As String, QDatei As String, QTabelle As String, QZelle As String
Dim Maske As String, Temp As String
'Syntax für einen Zellverweis mit Pfad auf eine externe Datei
Maske = "'@Pfad[@Datei]@Tabelle'!@Zelle"
With Sheets("Referenz")
On Error Resume Next
'Durchlaufe alle Zellen von A2 bis A?
For Each R In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
'Werte aus dieser Zeile einlesen (einfacher zu debuggen)
ZTabelle = .Range("A" & R.Row)
ZZelle = .Range("B" & R.Row)
QPfad = .Range("C" & R.Row)
QDatei = .Range("D" & R.Row)
QTabelle = .Range("E" & R.Row)
QZelle = .Range("F" & R.Row)
'Der Pfad muss einen \ am Ende haben
If Right(QPfad, 1)  "\" Then QPfad = QPfad & "\"
'Prüfen,ob Quelldatei existiert
If Dir(QPfad & QDatei) = "" Or QPfad = "" Or QDatei = "" Then
MsgBox "Die Datei" & vbLf & QPfad & QDatei & vbLf & "existiert nicht!", vbOKOnly, Title
Exit Sub
End If
'Prüfen,ob Quelldatei lokal geöffnet ist
If fncCheckFileOpen(QDatei) Then
MsgBox "Die Datei" & vbLf & QDatei & vbLf & "ist lokal geöffnet!", vbOKOnly, Title
Exit Sub
End If
'Syntax-String holen und die Felder ersetzen
Temp = Maske
Temp = Replace(Temp, "@Pfad", QPfad)
Temp = Replace(Temp, "@Datei", QDatei)
Temp = Replace(Temp, "@Tabelle", QTabelle)
Temp = Replace(Temp, "@Zelle", QZelle)
'Wert einlesen
Sheets(ZTabelle).Range(ZZelle) = DDE(Temp)
Next
End With
End Sub
Public Function fncCheckFileOpen(sNameWorkbook As String) As Boolean
'Prüft ob die Arbeitsmappe mit dem Namen geöffnet ist
Dim wkb As Workbook
On Error GoTo Fehler
Set wkb = Application.Workbooks(sNameWorkbook)
fncCheckFileOpen = True
Exit Function
Fehler:
fncCheckFileOpen = False
End Function
Function DDE(ByVal Reference As String) As Variant
Static XL As Application
On Error Resume Next
'Issue: When called as UDF and Reference is a cell, Excel supress the 1st ' if any
If InStr(Reference, "'!") > 0 And Left$(Reference, 1)  "'" Then Reference = "'" & _
Reference
If XL Is Nothing Then Set XL = CreateObject("Excel.Application")
DDE = XL.ExecuteExcel4Macro(Application.ConvertFormula(Reference, xlA1, xlR1C1, True))
End Function

Anzeige
AW: Fehlerbehandlung
19.01.2018 09:40:19
Ralf
Hallo Franz,
erstmal vielen Dank für Deine Antwort.
Ich habe den Code getestet und der Fall 1 (Datei existiert nicht) funktioniert wie gewünscht. Sehr gut.
Beim Fall 2 (Datei ist bereits geöffnet) ist das Verhalten jedoch unverändert. Excel arbeitet und hört ewig nicht auf - Folge: Excel muss beendet werden. Leider gibt Excel auch keine Fehler-Meldung aus.
Liegt es vielleicht an der Funktion "fncCheckFileOpen"? Muss ich noch Anpassungen vornehmen ? Was könnte die Ursache sein?
Gruss Ralf
AW: Fehlerbehandlung
19.01.2018 10:01:56
Peter(silie)
Hallo,
hier eine Alternative zu Franz Methode:

Sub test()
If FileExists(QPfad & QDatei) Then Debug.Print "Datei existiert"
If IsOpen(QPfad & QDatei) Then Debug.Print "Datei ist geöffnet"
End Sub
Private Function FileExists(ByVal FilePath As String) As Boolean
If Dir(FilePath, vbDirectory)  vbNullString Then FileExists = True
End Function
Private Function IsOpen(ByVal FilePath As String)
Dim file_ As Long
On Error Resume Next
file_ = FreeFile
Open FilePath For Binary Lock Read As #file_
Close #file_
If Err.Number  0 Then IsOpen = True
Err.Clear
End Function

Anzeige
AW: Fehlerbehandlung
19.01.2018 11:08:40
fcs
Hallo Ralf,
die von mir verwendete Method funktioniert seit Jahren/Jahrzehnten erfolgreich, um zu prüfen, ob eine Exceldatei bereits geöffnet ist. Ich hab dein Makro ja auch getestet mit einem kleinen Nachbau.
Dann liegt es womöglich doch auch daran, dass jemand anders die Datei schon geöffnet hat. Dann solltest du zusätzlich Peters Variante einbauen.
Außerdem bekommst auch einen Fehler, wenn das das Tabellenblatt in der Datei nicht vorhanden ist.
Um die Problemstellen zu finden musst du On Error Resume Next mal deaktivieren.
Zusätzlich könntest du noch folgens testen:
Application.DisplayAlerts = False
vor der Zeile mit For einfügen
Application.DisplayAlerts = True
nach der Zeile mit Next einfügen
Dann wird evtl. der Dialog zur Auswahl einer anderen Datei/Blatt nicht angezeigt, aber natürlich auch in der Zelle wohl nur ein Fehler angezeigt.
Gruß
Franz
Anzeige
AW: Fehlerbehandlung
19.01.2018 11:37:02
Ralf
Hallo Franz,
ich habe Deine Funktion isoliert und lokal mit einer geöffneten Datei getestet. In diesem Fall funktioniert Dein Code tatsächlich wie gewünscht. Es scheint also, als liegt es daran das er mit dem hinterlegten UNC Pfad des Netzwerks nicht zurecht kommt? Muss die Funktion ev. angepasst werden?
Den Code von Peter habe ich getestet jedoch läuft der Code auch ohne die planmäßigen Fehler Fall 1 und 2 nicht. Offenbar habe ich ihn nicht richtig eingebunden. Meine VBA Kenntnisse sind nicht so gut. Eine detallierte Ausführung zum einbinden (Arbeitsmappe; Arbeitsblatt; Modul) wäre hilfreich.
Auch die Application.DisplayAlerts habe ich getestet und das Verhalten bleibt unverändert. Excel hört nicht auf und muss beendet werden.
Gruß Ralf
Anzeige
AW: Fehlerbehandlung
19.01.2018 16:19:38
fcs
Hallo Rolf,
ich hab meine Tests jetzt mal etwas erweitert unter Windows 7, Office 2010 - dabei alle Makros in einem allgemeinen Modul. Ich konnte aber keinen Absturz von Excel provozieren.
Die von dir verwendete Function DDE wurde offenbar erstellt, um mit anderen Anwendungen (z.B. Word) auf Daten in einer Excel-Datei zuzugreifen. Dabei wird unsichtbar eine weitere Instanz von Excel geöffnet. Sichtbar im Taskmanager. Diese Instanz wird aber nirgendwo in den Makros wieder beendet. Sie bleibt "lebendig" bis das VBA-Projekt neu kompiliert wird oder Excel-Beendet wird und liegt danach als Karteileiche rum bis der Rechner runtergefahren wird.
Arbeitet man innerhalb von Excel-VBA mit dieser Function dann ist das Erstellen einer weiteren Excel-Instanz nicht nötig.
Die Function kann wie folgt angepasst werden:
Function DDE(ByVal Reference As String) As Variant
On Error Resume Next
'Issue: When called as UDF and Reference is a cell, Excel supress the 1st ' if any
If InStr(Reference, "'!") > 0 And Left$(Reference, 1)  "'" Then Reference = "'" & _
Reference
DDE = Application.ExecuteExcel4Macro(Application.ConvertFormula(Reference, xlA1, xlR1C1, True) _
)
End Function

Der Speicherort der Makros (Code-Modul von Tabelle, Arbeitsmappe oder allgemeines Modul) ist in deinem Fall nicht entscheidendend, da die Tabellenblätter immer vollständig referenziert werden.
Functions sollten in einem allgemeinen Modul als Public Function gespeichert werden. Dann kann man sie am einfachsten in anderen Modulen aufrufen.
Nachdem du die modifizierte Function DDE in der Excel-Datei eingebaut hast solltest du den Rechner runterfahren und neu starten, damit alter Daten-Müll verschwindet.
Gruß
Franz
Anzeige
AW: Fehlerbehandlung
19.01.2018 21:59:24
Ralf
Hallo Franz,
erstmal danke für den Tipp mit der DDE Funktion. Du hast recht, eine weitere Instanz ist geöffnet.
Zum analysieren des Problems habe ich mehrere Test mit verschiedenen Varianten gemacht.
Ergebnis: Die Ursache des auftretenden provozierten Verhaltens ist kein Absturz, sondern eine ewig dauernde Berechnung aufgrund der vielen unterschiedlichen Zeilen in den Referenzen. Sofern keine Datei lokal geöffnet ist, benötigt der Code ca. 60 Sekunden um alle 6000 Zellen aus 30 verschiedenen Dateien ("QPfad" und "QDatei" sind bei den 30 Dateien unterschiedlich)Der Aufbau in der Q-Dateien ist identisch.
Diese sehr lange Berechnung erfolgt immer dann, sofern die geöffnete Datei nicht an erster Stelle ("QPfad" und "QDatei") steht. Je weiter unten desto länger dauert es bis die Fehlermeldung erscheint.
Der Code funktioniert also wie gewünscht, jedoch müsste er etwas flotter sein. Da bei allen 30 Dateien die gleichen Zellen (H2:H30 + I2:I30 + J2:J30 + K2:K30) eingelesen werden, stellt sich die Frage ob sich der Code damit beschleunigen lässt?
Gruß Ralf
Anzeige
AW: Fehlerbehandlung
21.01.2018 00:40:13
fcs
Hallo Ralf,
für mich ist neu, dass du auch auf Daten in der Datei zugreifen willst/musst, in der die Quelldaten eingefügt werden sollen - die Zieldatei ist bei einigen Werten also auch die Quelldatei.
Das funktioniert nicht wenn in Function DDE eine 2. Excelinstanz benutzt wird.
Beschleunigen kann man das Ganze jetzt noch, indem man vorübergehend den Berechnungsmodus auf manuell setzt - das ist die wichtigste Massnahme.
Falls du mit Ereignismakro Worksheet_Change in den Tabellenblättern arbeitest, dann müssen auch die Ereignismakros vorübergehend deaktiviert werden.
Ein wenig mehr kann man noch optimieren, wenn die Anzahl der Zufriffe auf Zellen reduziert wird.
Ich hab dazu in einer weiteren Version mal die Daten aus Referenzen in ein Array geladen und auch die Ergebnisse von DDE werden zunächst in das Array geschrieben. Die Daten werden im Nachlauf dann in die Zieltabellen geschrieben.
Zusätzlich hab ich Zeitmessungen eingebaut. Daraus wird ersichtlich, dass der Großteil der Zeit für die Ausführung der DDE-Anweisungen benötigt wird.
Text-Datei mit angepasstem Makro: https://www.herber.de/bbs/user/119121.xlsm
Ich hab dann einen anderen Ansatz gewählt.
Statt die DDE-Function mit dem Excel4Macro zu verwenden weren Formeln ins Blatt Referenz in Spalte G eintragen, berechnet und dann die Werte übertragen - das sgeint wesentlich schneller zu funktionieren.
Textdatei mit optimiertem Makro: https://www.herber.de/bbs/user/119122.txt
Gruß
Franz
Anzeige
AW: Fehlerbehandlung
23.01.2018 15:34:01
Ralf
Hallo Franz,
ich habe den Code aus Deiner Datei übernommen und was soll ich sagen, beide Fehlerbehandlungen funktionieren wie gewünscht.
Zwar liegt die gemessene Dauer je nach Verbindung und verwendeter CPU immer noch zwischen 40-80 Sekunden. Aber die Geschwindigkeit spielt in dem Fall eine untergeordnete Rolle.
Die Zieldatei ist nicht Quelldatei. Aus 30 verschiedenen Quelldateien werden die Daten gesammelt und untereinander für eine Auswertung in der Zieldatei (mit diesem Code) gelistet. Alle Quelldateien sind vom Aufbau gleich. Beinhalten in den betreffenden Zellen jedoch unterschiedliche Werte. Diese Werte aus Zellen H2:K30 werden benötigt.
Die Umstellung auf den Berechnungsmodus "manuell" hat leider keine Auswirkungen auf die Geschwindigkeit gezeigt.
Die Variante mit Formeln und optimiertem Marko konnte ich bis jetzt noch nicht testen, werde es aber zeitnah machen.
In jedem Fall möchte ich mich für die Hilfe und Lösungsvorschläge bedanken.
Gruss Ralf
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige