das folgende Problem beschäftigt mich seit einigen Tagen.
Ich habe einen Kalender erstellt wo jedes Blatt einen Monat ausführlich beschreibt. Jetzt würde ich gerne die folgende Funktion einfügen…
Im allerersten Blatt habe ich Namen eingetragen von Freunden und Familie mit deren Geburtstagen. Zusätzlich habe ich, dem Internet sei Dank, eine Funktion eingefügt welche beim öffnen der Excel-Datei das Blatt anzeigt wird welches den aktuellen Monat beinhaltet. Jetzt würde ich gerne noch das eine Message-Box aufgeht und die jeweiligen Personen, welche am jeweiligen (aktuellen) Tag Geburtstag haben, angezeigt werden.
Also Quasi etwas wie:
"Heute haben folgende Personen Geburtstag:
Maik
Jürgen
Dennis
Herzlichen Glückwunsch!"
Sollte am jeweiligen Tag keiner Geburtstag haben braucht natürlich kein Fenster aufgehn…
Es ist schon ganz schön schwierig… für mich zumindest.
Das Script muss ja das Datum aus dem ersten Blatt entnehmen und mit dem Datum des Rechners vergleichen…
Der folgende Code macht, was Du haben wolltest. Du mußt ihn in das „Workbook_Open()“-Ereignis in „DieseArbeitsmappe“ hineinkopieren und wahrscheinlich anpassen an Deine Tabellen-Namen und Tabellen-Struktur.
Ich habe ihn geschrieben unter folgenden Annahmen:
Die Datümer stehen in Spalte A untereinander und haben das Format „19.11.2008“.
Die Namen stehen ab Spalte B bis Spalte xxx neben dem Datum
So, hier kommt jetzt der Code:
Const A As Long = 1 'Spalte A
Const B As Long = 2 'Spalte B
Dim Namen() As String 'Datenfeld, das die Namen enthalten soll
Dim AnzahlNamen As Long
Dim tmpZeile As Long
Dim tmpName As Long
Dim Meldung As String
'Datum suchen
For tmpZeile = 1 To Tabelle1.UsedRange.Rows.Count
If Tabelle1.Cells(tmpZeile, A) = Date Then
Exit For
End If
Next
'Datenfeld dimensionieren auf die maximal mögliche Anzahl Namen
ReDim Namen(1 To Tabelle1.UsedRange.Columns.Count)
'Feststellen, ob zu dem Datum Namen eingetragen sind und wenn ja, ins Datenfeld eintragen
For tmpName = B To Tabelle1.UsedRange.Columns.Count
If Len(Tabelle1.Cells(tmpZeile, tmpName)) \> 0 Then
AnzahlNamen = AnzahlNamen + 1
Namen(AnzahlNamen) = Tabelle1.Cells(tmpZeile, tmpName)
End If
Next
'Die Prozedur verlassen, falls keine Namen gefunden wurden
If AnzahlNamen = 0 Then Exit Sub
'Datenfeld auf die tatsächliche Anzahl Namen reduzieren
ReDim Preserve Namen(1 To AnzahlNamen)
'Meldung generieren
If LBound(Namen()) = UBound(Namen()) Then
Meldung = "Heute hat folgende Person Geburtstag:" & vbCr & vbCr
GoTo Melden
End If
If LBound(Namen())
Kannst Du ja 'mal ausprobieren
VG
Carsten
Also Quasi etwas wie:
"Heute haben folgende Personen Geburtstag:
Maik
Jürgen
Dennis
Herzlichen Glückwunsch!"
Sollte am jeweiligen Tag keiner Geburtstag haben braucht
natürlich kein Fenster aufgehn…
Hi Dimi,
die Namen stehen in Spalte A, in Spalte B die Geburstage.
Code gehört in „Diese Arbeitsmappe“:
Option Explicit
'
Private Sub Workbook\_Open()
Dim wks As Worksheet, Zei As Long, Mldg As String, Anz As Long
For Each wks In Worksheets
If wks.Name Like "\*" & MonthName(Month(Date)) & "\*" Then
wks.Activate
Exit For
End If
Next wks
With Worksheets(1)
For Zei = 1 To .Range("B" & Rows.Count).End(xlUp).Row
If Month(Date) = Month(.Cells(Zei, 2)) Then
If Day(Date) = Day(.Cells(Zei, 2)) Then
Anz = Anz + 1
Mldg = Mldg & .Cells(Zei, 1) & Chr(13)
End If
End If
Next Zei
If Anz \> 0 Then
Mldg = IIf(Anz = 1, "ist", "sind") & Chr(13) & Chr(13) & Mldg
Mldg = "Geburstagkind" & IIf(Anz = 1, "", "er") & " von heute " & Mldg
Mldg = Mldg & Chr(13) & "Herzlichen Glückwunsch"
MsgBox Mldg
End If
End With
End Sub
vielen Dank für deine Hilfe. Der Code passt perfekt, ich musste nichtmal grossartig was anpassen und er gibt genau das aus was ich es gerne hätte. Echt super!!!
Mein Dankeschön kommt etwas verspätet da ich erst gestern Abend dazu gekommen bin es auszuprobieren.
VG, Dimi.
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
erstmal Vielen Dank für den Code. Leider habe ich es nicht geschafft ihn in meinen anderen Code einzubauen. Es erscheint zwar die MsgBox aber sie zeigt nicht die Namen an… das liegt aber an mir, ich schaff es wohl nicht den richtig einzubauen… :-S Hab den mal auf eine leere Tabelle angewendet, also ohne anderen Code, und der funktioniert wunderbar aber in meiner Tabelle gibt es sicherlich irgendwo einen Konflikt und ich bin zu „schwach“ in Basic um das rauszufinden… :-S
Hab den jetzt von Reinhard genommen… der funzt ohne was zu machen.
Nochmals Vielen Dank für deine Mühe…
VG, Dimi.
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
