Fehler abfangen verursacht neuen Fehler
18.05.2005 21:41:10
marc
in der unten stehenden Prozedur will ich einen Fehler abfangen.
Falls im Worksheets("Ausw") [C9] kein Wert (leer ), dann Call Step_3A,
sonnst bearbeite die Mot-888 und Mot-889 Werte bis Ende.
Wenn der Wert 888 in [C9] steht, dann wird alles ohne Fehler abgearbeitet.
Wenn aber der erste Wert 888 in [C9] nicht vorhanden ist, dann läuft die
Sub-Prozedur bis Ende kommt aber zurück und bleibt stehen.
kann mir jemand helfen den Kreis zu verlassen !
marc :o(
Option Explicit
Sub Step_3T()
Dim wb As Workbook
Dim i As Integer
Dim str As String
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
Sheets("Werte").Activate
Selection.AutoFilter field:=3, Criteria1:="888"
Range("C8:J900").Copy
Sheets("Ausw").Activate
Range("C65536").End(xlUp).Offset(1, 0).Activate
ActiveCell.PasteSpecial Paste:=xlValues
Range("A8").Select
Application.CutCopyMode = False
Worksheets("Ausw").Activate
If [C9] = "888" Then
Sheets("Chart").Range("C7:C26") = Sheets("Ausw").Range("C9:C28").Value
Sheets("Chart").Range("D7:D26") = Sheets("Ausw").Range("D9:D28").Value
Sheets("Chart").Range("E7:E26") = Sheets("Ausw").Range("J9:J28").Value
End If
If [C9] = "888" Then
i = MsgBox("aktuelle Werte in Mot.888 werden ermittelt !" & vbCr & vbCr & _
" Bitte haben Sie etwas Geduld. ", vbExclamation, "MOT - 888")
Else: str = MsgBox("Keine Werte vorhanden!")
End If
If [C9] = Empty Then
Call Step_3A ''<------!?
End If
If [C9] = "888" Then
Worksheets("Chart").Activate
Range("D7:E26").Copy
Workbooks.Open ("C:\Lauf\Report\D_Rep.xls")
Worksheets("D.A90").Activate
Range("B9").PasteSpecial Paste:=xlValue
Range("B8").Activate
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
Worksheets("Ausw").Range("A9:J40").ClearContents
Worksheets("Chart").Range("C7:E26").ClearContents
Call Step_3A
End Sub
---------------------------------------------------------
Sub Step_3A()
Dim wb As Workbook
Dim i As Integer
Dim str As String
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
Worksheets("Werte").Activate
ActiveSheet.Rows(7).AutoFilter field:=3
Selection.AutoFilter field:=3, Criteria1:="889"
Range("C8:J900").Copy
Sheets("Ausw").Activate
Range("C65536").End(xlUp).Offset(1, 0).Activate
ActiveCell.PasteSpecial Paste:=xlValues
Range("A8").Select
Application.CutCopyMode = False
If [C9] = "889" Then
Sheets("Chart").Range("C7:C26") = Sheets("Ausw").Range("C9:C28").Value
Sheets("Chart").Range("D7:D26") = Sheets("Ausw").Range("D9:D28").Value
Sheets("Chart").Range("E7:E26") = Sheets("Ausw").Range("J9:J28").Value
End If
If [C9] = "889" Then
i = MsgBox("aktuelle Werte in Mot.889 werden ermittelt !" & vbCr & vbCr & _
" Bitte haben Sie etwas Geduld. " & vbCr & vbCr & _
" - weiter mit [OK] .", vbExclamation, "MOT - 889")
End If
If [C9] = "889" Then
Worksheets("Chart").Activate
Range("D7:E26").Copy
Workbooks.Open ("C:\Lauf\Report\D_Rep.xls")
Worksheets("D.A93").Activate
Range("B9").PasteSpecial Paste:=xlValue
Range("B8").Activate
End If
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Worksheets("Ausw").Range("A9:J40").ClearContents
Worksheets("Chart.90.93").Range("C7:E26").ClearContents
Worksheets("Werte").Activate
ActiveSheet.Rows(7).AutoFilter field:=3
Application.ScreenUpdating = True
i = MsgBox(" Aktuelle Werte wuden ausgewertet " & vbCr & vbCr & _
"und dem Verursacher zugeordnet !", vbInformation, "STEP-3 BEENDET")
End Sub
Anzeige