Makro abrechen
09.07.2007 18:15:00
Stefan
Folgedes Makro welches ein Passwort erfragt und dann eine Geburtstagsprüfung u.ä.
durchläuft funktioniert bei richtigem Passwort sehr gut ( Im Forum gefunden!).
Problem ist das wenn das falsche Passwort eingegeben wird, lande ich im Debug Modus .
Das Makro sollte jedoch bei Falschem Passwort abbrechen.
Für Eure Hilfe währe ich Dankbar
Grüße
Stefan
Private Sub workbook_open()
Dim s As String
s = InputBox("PASSWORT EINGEBEN")
If s = "admin" Then Sheets("Mitarbeiterdaten").Visible = True
If s = "admin" Then Sheets("Peko Ums Ohne MWSt").Visible = True
If s "admin" Then MsgBox ("Falsches Passwort")
Hier sollte es bei falschem Passwort aufhören !?
Dim Fr, lZeile, i, Jub1, Jub2, Jub3, Jub4, Geb
Worksheets("Mitarbeiterdaten").Select
ActiveSheet.Unprotect
'Voreinstellungen:
Fr = Date + 14 'befristete MitarbeiterFrist
Jub1 = 15 'Jubiläum 1
Jub2 = 25 'Jubiläum 2
Jub3 = 40 'Jubiläum 3
Jub4 = 50 'Jubiläum 4
Geb = 14 'Meldungsbereich Geburtstag
'alte Einfärbung löschen
Columns(1).Interior.ColorIndex = xlNone
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lZeile
'Prüfen, ob Termin "Befristung" in Frist
If Cells(i, 4) = Date Then
Cells(i, 1).Interior.ColorIndex = 3
MsgBox "Bei dem Mitarbeiter" & Chr(13) & Chr(13) _
& Cells(i, 1) & ", " & Cells(i, 2) & Chr(13) & Chr(13) _
& "läuft die Frist am " & Cells(i, 4) & " ab."
Else
Cells(i, 1).Interior.ColorIndex = xlNone
End If
'Prüfen, ob heute Geburtstag
If Month(Cells(i, 6)) = Month(Date) And Day(Cells(i, 6)) = Day(Now) Then
MsgBox Cells(i, 1) & ", " & Cells(i, 2) & Chr(13) & "hat heute Geburtstag" & Chr(13) _
& "und wird " & DateDiff("yyyy", Cells(i, 6), Date) & " Jahre alt"
Cells(i, 1).Interior.ColorIndex = 4
End If
'Prüfen ob bald Geburtstag:
If DateDiff("d", DateSerial(Year(Now + Geb), Month(Cells(i, 6)), Day(Cells(i, 6))), Date) > Geb _
_
_
_
_
* -1 And _
DateDiff("d", DateSerial(Year(Now + Geb), Month(Cells(i, 6) + Geb), Day(Cells(i, 6) + Geb)), _
_
_
Date) -14 And _
DateDiff("d", DateSerial(Year(Cells(i, 3)) + Jub1, Month(Cells(i, 3)), Day(Cells(i, 3))), _
_
_
Date) -14 And _
DateDiff("d", DateSerial(Year(Cells(i, 3)) + Jub2, Month(Cells(i, 3)), Day(Cells(i, 3))), _
_
_
Date) -14 And _
DateDiff("d", DateSerial(Year(Cells(i, 3)) + Jub3, Month(Cells(i, 3)), Day(Cells(i, 3))), _
_
_
Date) -14 And _
DateDiff("d", DateSerial(Year(Cells(i, 3)) + Jub4, Month(Cells(i, 3)), Day(Cells(i, 3))), _
_
_
Date)
Anzeige