On Error Code komplett abrechen
SteffenS
ich habe in meine Makros eine Errorbehandlung eingebaut.
Nun werden manche Makros von anderen Markros aufgerufen. Entsteht in Makros 2 ein Fehler so läuft in meinem Fall der Code in Makros 1 weiter.
Was muss ich tun damit in der Fehlerbehandlung der komplette Code abgebrochen wird. Es wäre gut wenn ich den Abbruch in die Fehlerbehandlung einbauen könnte (Dies ermöglicht die Administration)
Bsp.
Sub Makro1()
If ErrorOn_app = True Then On Error GoTo Err_Exit
Makro2
Msgbox("Test")
'Fehlerbehandlung************************************************************************
Err_Exit:
If ErrorOn_app = True And err.Number Then ErrorHandler_APP err, "aopen", "dekl_all_files", Erl
End Sub
Sub Makro2()
If ErrorOn_app = True Then On Error GoTo Err_Exit
MSgbox(1/0)
'Fehlerbehandlung************************************************************************
Err_Exit:
If ErrorOn_app = True And err.Number Then ErrorHandler_APP err, "aopen", "dekl_all_files", Erl
End Sub
Fehlerbeandlung
Sub ErrorHandler_APP(ByRef ErrorObject As ErrObject, ByVal Modulname As String, ByVal _
Procedurename As String, ByVal LineNumber As Long)
'Fehlermeldung definieren
Dim err_txt As String, err_det As String
err_txt = "Bitte entschuldigen Sie," & vbLf & "bei der Ausführung des Programmes ist ein _
Fehler aufgetreten." & vbLf & "Sollte diese Fehler erneut auftreten wenden Sie sich bitte an _
Ihren Systembetreuer."
err_det = "Beschreibung:" & vbTab & ErrorObject.Description & " (Code: " & ErrorObject.Number _
_
& ")" & vbLf & _
"Modul:" & vbTab & vbTab & Modulname & vbLf & _
"Prozedur:" & vbTab & vbTab & Procedurename & " (Zeile: " & LineNumber & ")"
'Fehler anzeigen
If ErrorShow_app = True Then Call MsgBox(err_txt & vbLf & vbLf & err_det, vbInformation, _
pr_name)
'Fehler sichern (Log)
If Error_Log_app = True Then
Dim ADMB As Worksheet
Set ADMB = Workbooks(ThisWorkbook.Name).Sheets("tb_a_anzeigen")
Dim i As Long, aID As Long
i = ADMB.Cells(ADMB.Rows.Count, 14).End(xlUp).Row + 1
'ID ermitteln
If i = 11 Then
aID = 90000
Else
aID = WorksheetFunction.Max(ADMB.Range("N10:N" & i)) + 1
End If
'schutz aufheben
ws_schutz_aufheben ADMB
'Fehler in Tabelle eintragen
ADMB.Cells(i, 14).Value = aID
ADMB.Cells(i, 15).Value = Format(Now, "dd.mm.yyyy hh:mm:ss")
ADMB.Cells(i, 16).Value = ActiveWorkbook.Name
ADMB.Cells(i, 17).Value = ActiveSheet.Name
ADMB.Cells(i, 18).Value = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
ADMB.Cells(i, 19).Value = ActiveCell.Value
ADMB.Cells(i, 20).Value = Modulname
ADMB.Cells(i, 21).Value = Procedurename
ADMB.Cells(i, 22).Value = LineNumber
ADMB.Cells(i, 23).Value = ErrorObject.Number
ADMB.Cells(i, 24).Value = ErrorObject.Description
ADMB.Cells(i, 25).Value = Environ("USERNAME")
'Spaltenbreite
ADMB.Columns("N:Y").Columns.AutoFit
'Rahmen setzen
With ADMB.Range("N10:Y" & i)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'schutz setzen
ws_schutz_setzen ADMB
End If
'globale Variablen neu setzen
dekl_all_files
End Sub
Danke Euch schonmalVG
Steffen Schmerler