Wer kann mir helfen ich werd noch bekloppt. Habe diesen Code ausm Netz gezogen und weiß nicht ihn umzusetzten!?!?!? Hat jemand Zeit und Lust mir das Ding fertig zu machen und zuzuschicken.
Würde mich tausendmal bedanken. Wie kann ich mich revangieren?
Danke Mark
Geburtstagsmeldung bei Öffnen der Arbeitsmappe
Sub auto_open()
Dim X As Object
Dim GebListe As Range
Dim Y%, lZeile%, lSpalte
Dim GebDaten()
Dim Meldung As String
Worksheets("Spieler").OnEntry = "Eintragen"
lZeile = Range("c" & Rows.Count).End(xlUp).Row
Set GebListe = Range(Cells(2, 4), Cells(lZeile, 4))
Y = 0: Meldung = ""
For Each X In GebListe.Cells
If Month(X.Value) = Month(Date) And Day(X.Value) = Day(Date) Then
ReDim GebDaten(Y)
GebDaten(Y) = Cells(X.Row, 4) & " " & Cells(X.Row, 2) & _
" wird heute " & Year(Date) - Year(X.Value) & " Jahre alt!"
Meldung = Meldung & Chr(10) & GebDaten(Y)
Y = Y + 1
If
Next X
[a1].Select
If Meldung <> "" Then MsgBox "Geburtstage:" & Chr(10) & Meldung
If Meldung = "" Then MsgBox "Heute liegt kein Geburtstag an!"
End Sub
Sub auto_close()
Worksheets("Spieler").OnEntry = ""
End Sub
Sub Eintragen()
Dim AC As Range
Set AC = Application.Caller
If AC.Column <> "D" Then Exit Sub
AC.Offset(0, 1) = Year(AC)
AC.Offset(0, 2) = Month(AC)
AC.Offset(0, 3) = Day(AC)
AC.Offset(0, -1) = Year(Date) + 1 - AC - 1900
End Sub
Sub Sortieren()
Dim Alles As Range, lZeile%, lSpalte%
lSpalte = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
Application.ScreenUpdating = False
lZeile = Range("a" & Rows.Count).End(xlUp).Row
Set Alles = Range("a1:g" & lZeile)
Alles.Sort Key1:=Range("f2"), Order1:=xlAscending, Key2:=Range("g2") _
, Order2:=xlAscending, Key3:=Range("e2"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub