Makrolauf abbrechen/beenden
18.12.2014 22:35:44
Werner
ich benötige wieder Eure Hilfe.
Mit folgendem Code öffne ich aus einem geschlossenen Ordner nacheinander mehrere Dateien.
Es können bis zu 48 Dateien nacheinander geöffnet werden.
Ab welcher Datei und die Anzahl der Dateien zum Einlesen werden aus Zellen vorgegeben.
Nachdem eine Datei geöffnet worden ist, werden automatisch in dieser Datei Werte eingelesen,
danach die Datei geschlossen und die nächste Datei geöffnet.
Wenn in der letzten Datei die Werte eingelesen worden sind und die Datei geschlossen,
so ist der Codedurchlauf beendet.
Gerade beim Einlesen mehrerer Dateien, möchte ich den Schleifendurchlauf abbrechen können.
Mit dem Drücken der ESC-Taste, möchte ich keinen Abbruch vornehmen.
Evtl. mit einen Abbruch-Button auf dem Tabellenblatt oder, dass nach jedem Einlesen
der Codedurchlauf angehalten wird, eine MsgBox öffnet sich und mit OK / Stopp-Taste
kann der Codedurchlauf fortgeführt oder abgebrochen werden.
Sub CommandButton55_Click()
Dim strPath As String
Dim objWorkbook As Workbook
Dim fso As Object
' For-Next-Schleife mit numerische Variablen.....
Dim lngIndex As Long
' Start-, Endwert und Schritt variabel.....
Dim lngStart As Long
Dim lngEnd As Long
'Dim lngStep As Long
On Error GoTo DispFehler
' Mit dem FSO-Modell können Informationen zu Ordnern abgerufen werden,
' z. B. der Name oder das Erstellungs- bzw. Änderungsdatum
' und auch die Anzahl der Dateien im Ordner.
' Mit der CreateObject-Methode, wird ein FileSystemObject-Objekt erstellt.
Set fso = CreateObject("Scripting.FileSystemObject")
If Range("D39") = False Then _
lngStart = Range("F38")
lngEnd = Range("I38")
'If Range("D39") = True Then _
'Range("F38") = ""
'Rang'lngStart = 1
'lngEnd = fso.GetFolder(ActiveWorkbook.Path & "\Umsatz ET").Files.Count - 8 ' _
mit GetFolder, wird ein Ordner aufgerufen.....
For lngIndex = lngStart To lngEnd
' Die Bildschirmaktualisierung wird abgeschaltet.
' Das verhindert einen flackernden Bildschirm und beschleunigt damit den VBA-Code.
Application.ScreenUpdating = False
strPath = FindFile(ActiveWorkbook.Path, CStr("Whn " & lngIndex & ".xlsm"))
If strPath vbNullString Then
Set objWorkbook = Workbooks.Open(Filename:=strPath)
Else
MsgBox "Datei nicht" & vbCrLf & "gefunden!", vbExclamation, " Es tut mir leid!"
End If
' Application.Run führt ein VBA-Makro aus. Der Makroname-Parameter besteht
' aus Dateiname mit Erweiterung, Code Name Tabellenblatt und Button.
Application.Run "'Whn " & lngIndex & ".xlsm" & "'!Tabelle1.CommandButton1_Click"
' DisplayAlerts, was soviel heißt wie Warnung anzeigen.
' Wird dies auf false gesetzt, werden Warnungen unterdrück.
' Der Benutzer wird nicht aufgefordert, Änderungen zu speichern.
'Application.DisplayAlerts = False
objWorkbook.Close True ' Datei wird gespeichert, während sie geschlossen wird.....
If GetInputState Then DoEvents
Next
' DisplayAlerts einschalten.....
DispFehler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True ' Die Bildschirmaktualisierung wird wieder _
eingeschaltet.....
End Sub
reichen nicht aus, eine funktionierende Lösung zu erstellen.
Wer kann mir behilflich sein?
Für evtl. Tipps oder Anregungen schon mal besten Dank!
Werner