Do ... Loop beenden ohne Fehlermeldung
20.09.2018 12:41:34
Georg
Es funktioniert alles super bitte nur das Augenmerk auf folgendes richten:
Sind alle Dateien "abgearbeitet" und ich gehe im Datei Öffnen Dialog auf abbrechen,
kommt immer eine Fehlermeldung, die ich wegklicken kann.
Es stört jetzt nicht wirklich groß, aber ich würde diese gerne loswerden u v. a. wissen warum diese erscheint, bzw. was ich ändern muss im Sinne von Dazulernen.
Falls j-d mal Zeit hat kurz darüber zu schauen, wäre prima, DANKE:
Public Sub Konsolidieren()
Dim strFileName As String
Dim objWorkbook As Workbook
Dim i As Integer
Dim strFilter As String
Dim strString As String
Dim rngCell As Range
'Errorhandler initialisieren
On Error GoTo err_exit
'DateiÖffnen Dialog
strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Z"
ChDir "Q:\XX\XX\" '** Laufwerk und Pfad definieren
strFileName = Application.GetOpenFilename(strFilter)
'Schleife
If strFileName "" Then
Do
'Excelmappe öffnen
Set objWorkbook = Workbooks.Open(Filename:=strFileName)
'Die eigentliche Aufgabe: verbundene Zellen auflösen, Spalte G wird dadurch überflüssig _
--> löschen, Spalte F Autofit
For i = 1 To objWorkbook.Worksheets.Count
With objWorkbook.Worksheets(i)
.UsedRange.Cells.UnMerge
.Columns("G:G").Delete
.Columns("F:F").AutoFit
End With
Next i
'Optisches Aufpeppen
For i = 1 To objWorkbook.Worksheets.Count
With objWorkbook.Worksheets(i)
strString = "Bitte senden.."
Set rngCell = Worksheets(i).Columns(1).Find(strString, lookat:= _
xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngCell Is Nothing Then
rngCell.Copy rngCell.Offset(, 4)
rngCell.ClearContents
End If
End With
Next i
'Excelmappe schließen - ohne zu speichern = False / mit speichern = True
objWorkbook.Close SaveChanges:=True
Dim a As String
a = MsgBox("Die Datei wurde gespeichert", vbYes)
'nächste Excelmappe suchen
strFileName = Application.GetOpenFilename(strFilter)
'wird keine Mappe mehr gefunde Schleife verlassen
Loop Until strFileName = ""
End If
Exit Sub
err_exit:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung"
End Sub