Fehler überspringen

Private Sub Workbook_Open() Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer Dim arrJub(1 To 6) As Integer, intI As Integer Const iVn As Integer = 3 ' Spalte C - Vornamen Const iNn As Integer = 2 ' Spalte D - Nachnamen Const iG As Integer = 7 ' Spalte H - Geburtstage Const iEin As Integer = 8 ' Spalte I - Eintrittsdatum arrJub(1) = 10 ' 10-jähriges Jubiläum arrJub(2) = 20 ' 20-jähriges Jubiläum arrJub(3) = 25 ' 25-jähriges Jubiläum arrJub(4) = 30 ' 30-jähriges Jubiläum arrJub(5) = 40 ' 40-jähriges Jubiläum arrJub(6) = 50 ' 50-jähriges Jubiläum ActiveSheet.Protect Password:="" Beep ' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden) sMldg1 = "Geburtstage:" & vbLf lR = 2 Do Until IsEmpty(Cells(lR, iVn)) iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date If iDiff "" Then MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau" Else MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info" End If End If ' Überprüfung auf Jubiläen sMldg3 = "Jubiläum:" & vbLf lR = 2 Do Until IsEmpty(Cells(lR, iVn)) For intI = LBound(arrJub) To UBound(arrJub) iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _ Day(Cells(lR, iEin))) - Date If iDiff1 "" Then MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau" Else MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info" End If End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer Dim arrJub(1 To 6) As Integer, intI As Integer Const iVn As Integer = 3 ' Spalte C - Vornamen Const iNn As Integer = 2 ' Spalte D - Nachnamen Const iG As Integer = 7 ' Spalte H - Geburtstage Const iEin As Integer = 8 ' Spalte I - Eintrittsdatum arrJub(1) = 10 ' 10-jähriges Jubiläum arrJub(2) = 20 ' 20-jähriges Jubiläum arrJub(3) = 25 ' 25-jähriges Jubiläum arrJub(4) = 30 ' 30-jähriges Jubiläum arrJub(5) = 40 ' 40-jähriges Jubiläum arrJub(6) = 50 ' 50-jähriges Jubiläum ActiveSheet.Protect Password:="" Beep ' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden) sMldg1 = "Geburtstage:" & vbLf lR = 2 Do Until IsEmpty(Cells(lR, iVn)) If IsDate(Cells(lR, iVn)) Then iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date If iDiff End If Loop If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!" If MsgBox(sMldg1, vbOKCancel, "Info") = vbOK Then If sMldg2 "" Then MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau" Else MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info" End If End If ' Überprüfung auf Jubiläen sMldg3 = "Jubiläum:" & vbLf lR = 2 Do Until IsEmpty(Cells(lR, iVn)) If IsDate(Cells(lR, iVn)) Then For intI = LBound(arrJub) To UBound(arrJub) iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _ Day(Cells(lR, iEin))) - Date If iDiff1 End If Loop If sMldg3 = "Jubiläum:" & vbLf Then sMldg3 = "Heute kein Jubiläum!" If MsgBox(sMldg3, vbOKCancel, "Info") = vbOK Then If sMldg4 "" Then MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau" Else MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info" End If End If End Sub

Hallo Christopher,
ich habe den Fehler gefunden. Der Zeilenindex - Erhöher
lR = lR + 1
stand innerhalb des IF-Blockes. Dadurch wird das DO-LOOP eine Endlosschleife, da Excel ewig in der ersten nicht-leeren Zelle hängen bleibt.
Hier der neue Code, Änderung (einfach 2x 2 Zeilen getauscht!) fett:


Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer
Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer
Dim arrJub(1 To 6) As Integer, intI As Integer
Const iVn As Integer = 3   ' Spalte C - Vornamen
Const iNn As Integer = 2   ' Spalte D - Nachnamen
Const iG As Integer = 7    ' Spalte H - Geburtstage
Const iEin As Integer = 8  ' Spalte I - Eintrittsdatum
arrJub(1) = 10    ' 10-jähriges Jubiläum
arrJub(2) = 20    ' 20-jähriges Jubiläum
arrJub(3) = 25    ' 25-jähriges Jubiläum
arrJub(4) = 30    ' 30-jähriges Jubiläum
arrJub(5) = 40    ' 40-jähriges Jubiläum
arrJub(6) = 50    ' 50-jähriges Jubiläum
ActiveSheet.Protect Password:=""
Beep
' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden)
sMldg1 = "Geburtstage:" & vbLf
lR = 2
Do Until IsEmpty(Cells(lR, iVn))
If IsDate(Cells(lR, iVn)) Then
iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
If iDiff      End If
lR = lR + 1
Loop
If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!"
If MsgBox(sMldg1, vbOKCancel, "Info") = vbOK Then
If sMldg2  "" Then
MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau"
Else
MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info"
End If
End If
' Überprüfung auf  Jubiläen
sMldg3 = "Jubiläum:" & vbLf
lR = 2
Do Until IsEmpty(Cells(lR, iVn))
If IsDate(Cells(lR, iVn)) Then
For intI = LBound(arrJub) To UBound(arrJub)
iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _
Day(Cells(lR, iEin))) - Date
If iDiff1      End If
lR = lR + 1
Loop
If sMldg3 = "Jubiläum:" & vbLf Then sMldg3 = "Heute kein Jubiläum!"
If MsgBox(sMldg3, vbOKCancel, "Info") = vbOK Then
If sMldg4  "" Then
MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau"
Else
MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info"
End If
End If

Übrigens: ich bin, unter anderem aus diesem Grund, kein Freund von DO-LOOP Schleifen. Ich finde die einfach unübersichtlich. Den o.g. Code könnte man leicht auf FOR-NEXT Schleifen umstellen und auf diesen Zeilenindexzähler ganz verzichten (soll ich?).
Übrigens 2: ein so langer Code gehört nicht in "Workbook Open". Aus Prinzip nicht! Pack den lieber in ein eigenes Modul unter einem sprechenden Namen, und Calle das Makro aus WorkbookOpen. Macht - in diesem Fall - zwar Null unterschied, aber man sollte sich schnell angewöhnen seine Ereignissprozeduren übersichtlich zu halten. Auto-Analogie: Wenn die Karre total verdreckt ist, fährt sie trotzdem genausogut wie vorher. Eine Fahrt durch die Waschstrasse schadet aber nicht.
Grüße,
Klaus M.vdT.

Sub GebUndJubHolen() Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer Dim arrJub(1 To 6) As Integer, intI As Integer Dim lRowLast As Long Dim lRowFirst As Long Const iVn As Integer = 3 ' Spalte C - Vornamen Const iNn As Integer = 2 ' Spalte D - Nachnamen Const iG As Integer = 7 ' Spalte H - Geburtstage Const iEin As Integer = 8 ' Spalte I - Eintrittsdatum arrJub(1) = 10 ' 10-jähriges Jubiläum arrJub(2) = 20 ' 20-jähriges Jubiläum arrJub(3) = 25 ' 25-jähriges Jubiläum arrJub(4) = 30 ' 30-jähriges Jubiläum arrJub(5) = 40 ' 40-jähriges Jubiläum arrJub(6) = 50 ' 50-jähriges Jubiläum 'ActiveSheet.Protect Password:="" Beep ' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden) sMldg1 = "Geburtstage:" & vbLf 'erste Zeile lRowFirst = 2 'letzte Zeile lRowLast = Cells(Rows.Count, iG).End(xlUp).Row For lR = lRowFirst To lRowLast If IsDate(Cells(lR, iG)) Then 'auf IG geändert! iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date If iDiff "" Then MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau" Else MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info" End If End If ' Überprüfung auf Jubiläen sMldg3 = "Jubiläum:" & vbLf 'letzte Zeile lRowLast = Cells(Rows.Count, iEin).End(xlUp).Row For lR = lRowFirst To lRowLast If IsDate(Cells(lR, iEin)) Then 'auf iEin geändert For intI = LBound(arrJub) To UBound(arrJub) iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _ Day(Cells(lR, iEin))) - Date If iDiff1 "" Then MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau" Else MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info" End If End If End Sub

…Folks;
es ist immer ratsam, solche speziellen Vorgänge nicht direkt in eine Ereignisprozedur zu stecken (mache ich leider auch manchmal), sondern in eine ExtraProzedur, die dann (ggf unter bestimmten Bedingungen) aus der Ereignisprozedur heraus aufgerufen wird. Dadurch bleibt Letztere übersichtlich und lässt sich deshalb auch noch gut für Anderes verwenden.
On Error Resume Next kann uU sinnvoll sein, aber selten für die ganze Prozedur (eine Ausnahme können ggf UDF mit FehlerAuswertung und variantem Ergebnis sein). Wenn ein Wert (bzw Parameter) fehlen darf, sollte man diesen Fall direkt abfragen und, falls erforderlich, das On Error Resume Next nur hierfür gelten lassen (also davor notieren und danach wieder On Error GoTo fm (fm = irgendeine gesetzte Sprungmarke, bei der die FehlerBehandlung beginnt). Ohne Fehlerbehandlung (On Error GoTo 0 ) läuft man Gefahr, dass während der Abarbeitung eine VBA-Standard-Fehlermeldung erscheint, über die ins CodeModul gesprungen wdn kann. Ist das CodeProjekt geschützt, kommt eine kryptische Fmeldung wie Fehler in verborgenem Modul und aus ist's. Was soll ein (VBA-unkundiger) Endnutzer damit anfangen?
Gruß Luc :-?

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fehler überspringen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

93 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread