Starfolge Userform
26.08.2007 14:34:00
Heinz
Wenn ich das Pogr. starte kommt eine PW abfrage in UF
Ich möchte gerne wenn das PW beim öffnen des Pogr.falsch ist das UF 2 erscheint.
Wenn das PW richtig ist das UF1 erscheint.
Könnte mir Bitte jemand weiterhelfen ?
Danke & Gruß Heinz
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim Frage As String
Paßwort_Eingabe.Show
If Frage = "1908" Then
'######################################################
'# #
'# Diese Makros stammen von Bert Körn , modifiziert von fcs 2008-08-19#
'# E-Mail: bert@excelabc.de #
'# Homepage: http://www.excelabc.de
'#
'# #
'######################################################
'Sub Erinnerung()
Dim Fr, lZeile&, i&, Jub1, Jub2, Jub3, Jub4, Geb%, Alter%, strName$
Dim Geb7%, GebJahr As Date, GebBald As Date, GebHatte As Date
Worksheets("Haupt").Select
'Voreinstellungen:
Geb = 14 'Meldungsbereich Geburtstag
Geb7 = -7 'Meldungsbereich Geburtstag vergessen?
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lZeile
'Berechnung des Alters des Gebutstagskindes im Prüfzeiraum
Alter = DateDiff("yyyy", Cells(i, 6) + Geb, Date)
'Datum Geburtstag im aktuellen Jahr
GebJahr = DateSerial(Year(Date), Month(Cells(i, 6)), Day(Cells(i, 6)))
' Name des Geburtstagskindes
strName = Cells(i, 1) & ", " & Cells(i, 2)
'Vergleichstag für Geburtstag festlegen
Select Case Month(GebJahr)
Case 1 'Geburtstag im Januar
If Month(Date) = 12 Then
'bei aktuellem Datum im Dezember wird Bald-Geburtstag mit nächsten Jahr verglichen
GebBald = DateSerial(Year(Date) + 1, Month(Cells(i, 6)), Day(Cells(i, 6)))
GebHatte = GebJahr
Else
GebBald = GebJahr
GebHatte = GebJahr
End If
Case 12 'Geburtstag im Dezember
'bei aktuellem Datum im Januar wird Hatte-Geburtstag mit letzten Jahr verglichen
If Month(Date) = 1 Then
GebBald = GebJahr
GebHatte = DateSerial(Year(Date) - 1, Month(Cells(i, 6)), Day(Cells(i, 6)))
Else
GebBald = GebJahr
GebHatte = GebJahr
End If
Case Else
GebBald = GebJahr
GebHatte = GebJahr
End Select
'Prüfen, ob heute Geburtstag
If GebJahr = Date Then
MsgBox strName & " hat heute Geburtstag" & Chr(13) _
& "und wird " & Alter & " Jahre alt", _
vbOKOnly + vbInformation, "Geburtstag heute"
'Cells(i, 1).Interior.ColorIndex = 4
End If
'Prüfen ob bald Geburtstag
If DateDiff("d", Date, GebBald) > 0 And _
DateDiff("d", Date, GebBald) MsgBox strName & " hat am" & Chr(13) _
& Format(GebBald, "DDDD DD.MM.YYYY") & " Geburtstag" & Chr(13) _
& "und wird " & Alter & " Jahre alt", _
vbOKOnly + vbInformation, "Geburtstag nächste " & Geb & " Tage"
End If
'Prüfen ob letzte Woche Geburtstag
If DateDiff("d", Date, GebHatte) >= Geb7 And _
DateDiff("d", Date, GebHatte) MsgBox strName & " hatte am" & Chr(13) _
& Format(GebHatte, "DDDD DD.MM.YYYY") & " Geburtstag" & Chr(13) _
& "und wurde " & Alter & " Jahre alt", _
vbOKOnly + vbInformation, " Geburtstag Erinnerung"
'vbOKOnly vbInformation, "Geburtstag letzte " & -Geb7 & " Tage"
End If
Next i
'End Sub
Private Sub UserForm_Initialize()
TXT_Paßwort.SetFocus
End Sub
Private Sub UserForm_Activate()
Application.Wait (Now + TimeSerial(0, 0, 3))
Unload Me
End Sub
