Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
120to124
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
120to124
120to124
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hilfe beim Geburtstagskalender

Hilfe beim Geburtstagskalender
25.05.2002 17:10:52
Mark
Hi Leute
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Hilfe beim Geburtstagskalender
25.05.2002 17:49:48
snore
hallo mark,
kann die eine beispielmappe zusenden wenn du es möchtest.

mfg
snore

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige