Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
808to812
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
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Geburtstags Liste

Geburtstags Liste
13.10.2006 07:48:51
Manfred
Hallo liebe Excelexperten,
Habe mir eine kleine private Telefonliste mit UserFormen gebastellt.
Nun möchte ich das beim öffnen dieser Mappe, wenn eine Person
Geburtstag hat dieser in eine MsgBox angezeigt wird. Kann mir dazu jemand
einen Tipp geben ?.
Im Voraus Danke für Eure Hilfe.
mfg
Manfred

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Geburtstags Liste
13.10.2006 08:07:42
Bertram
Hallo Manfred,
das sollte kein all zu großes Problem sein. Allerdings solltest du schon sagen wie deine Tabellen bzw. dein UF aufgebaut sind. Ohne Glaskugel wird's aschwierig.
Wo stehen denn die Geburtsdaten? Generell einfach abfragen bzw. nach dem heutigen Datum in den anderen suchen und entsprechenden Eintrag anzeigen.
Gruß
Bertram
AW: Geburtstags Liste
13.10.2006 08:15:34
GeorgK
Hallo Manfred,
kannst Du vielleicht anpassen.
Stammt von Sepp aus diesem Forum und zeigt die Geburtstage der nächsten Tage an.

Private Sub Workbook_Open()
'Datum steht in Spalte "A"
'Name Steht in Spalte "B"
'Adresse steht in Spalte "C"
Dim n As Integer
Dim rng As Range
Dim strText As String
Dim blnFound As Boolean
strText = "Anstehende Geburtstage:" & Space(125) & vbLf & vbLf & "Datum" & _
vbTab & vbTab & vbTab & "Name" & vbTab & vbTab & vbTab & "Adresse" & vbTab & _
vbTab & vbTab & "Zeile" & vbLf & vbLf
For Each rng In Sheets("Tabelle1").Range("A1:A1500")
'Tabellenname und Bereich anpassen
If IsDate(rng) Then
If DateDiff("d", Date, DateSerial(Year(Date), _
Month(rng), Day(rng)), vbMonday) < 7 Then
blnFound = True
'"Offset() anpassen!
strText = strText & Format(rng, "ddd dd.mm") & vbTab & vbTab & vbTab & _
rng.Offset(0, 1) & vbTab & vbTab & vbTab & rng.Offset(0, 2) & _
vbTab & vbTab & rng.Row & vbLf
End If
End If
Next
If blnFound Then
MsgBox strText & vbLf & vbLf, , "Geburtstage"
End If
End Sub

Grüße
Georg
Anzeige
AW: Geburtstags Liste
13.10.2006 08:16:06
UweD
Hallo
Bei folgendem Tabellenaufbau sähe ein Makro so aus.
Tabelle1
 ABCDEFG
1NameVormameStrassePLZOrtTelGeburtstag
2SchmidtBirgitSchleichweg 844444Dort0789 / 999901.11.1999
3MüllerMaxMusterstr. 112345Irgendwo0123/45613.10.1970
 

Durch Anpassung der Spaltenbelegung an deine Tabelle leicht änderbar


      
Private Sub Workbook_Open()
    
Dim SPGeb%, SpNam%, SPVornam%, Wer$, Alter%, RR&, TB1, i&, Geb As Date
    
On Error GoTo Fehler
    
    
'* Start anpassen********
    Set TB1 = Sheets("Tabelle1"'aus bestimmtem Blatt
    SPGeb = 7 'Spalte G mit Geburtstag
    SpNam = 1
    SPVornam = 2
    
'* Ende anpassen **********
    
    RR = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 
'Letzte Zeile des gesamten Blattes
    For i = 2 To RR
        Geb = TB1.Cells(i, SPGeb)
        
If DateSerial(Year(Date), Month(Geb), Day(Geb)) = Date Then
            Wer = Cells(i, SPVornam) & 
" " & Cells(i, SpNam) & " "
            Alter = DateDiff(
"YYYY", Geb, Date, vbMonday, vbFirstFourDays)
            MsgBox 
"Heute wird " & Wer & Alter & " Jahre alt" _
                , vbExclamation, 
"Happy Birthday"
        
End If
    
Next
Fehler:
    
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub 


Gruß UweD
(Rückmeldung wäre schön)
Anzeige
AW: Geburtstags Liste
13.10.2006 08:24:41
Manfred
Hallo Experten,
Danke für Eure Hilfe.Ihr habt mir sehr geholfen.
mfg Manfred

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige