O gün doğum günü olanlar için detaylı açılır pencere

[Researcher]

merhaba arkadaşlar,

400 kişilik bir çalışan kadromuz var. günlük olarak doğum günleri kırmızı bir şekilde gösteriyor bunun yanında o ay içinde doğum günü olanları da mavi olarak göstermekte. ama bazen işin yoğunluğundan gözümüzden kaçabiliyor. benim istediğim excel dosyasını her açtığımda sadece o gün doğum günü olanlar ekranda bir açılır pencere de belirsin. detaylı olacağı için yeni bir konu açmak istedim

Sütunlar şu şekilde olması gerek.

Adı-soyadı, İşletme, Departman, Görev, Doğum Tarihi, Yaş


sıralama da ilk başta hoteldekiler ardından casinodakiler şeklinde olması gerek

örnek bir dosya ekledim

yardımlarınızı bekliyorum

 

[acar6783]

Private Sub Workbook_Open()
Set s1 = Sheets("sayfa1")
For i = 2 To s1.Cells(Rows.Count, "s").End(xlUp).Row
If Day(s1.Cells(i, "s")) = Day(Now) Then

MsgBox ("Bugün " & Chr(10) & Cells(i, "b").Value & " 'ın " & Chr(10) & " Doğum Günü")
End If
Next
End Sub

çalışma kitabının kod bölümüne yapıştırın.
Mesaj kutusu olarak çıkacak.

 

[Researcher]

kodu girdim. f5 e basınca pencere çıkıyor bugun a nın doğum günü diye ama. tek tek çıkıyor doğum günü olanlar. benim istediğim sadece tek bir liste içinde çıkması ve yukarıda belirttiğim detaylarında olması (işletme, departman, görev vs.). ayrıca çalışma kitabını açdığımda gelmiyor ekran

 

[Necdet]

Merhaba,

Aşağıdaki kodları BuÇalışmaKitabı'nın kod bölümüne kopyalayıp deneyinz.
Not :

• Bu işlemi pazartesi günü yapıyorsanız Cumartesi Pazar günleri doğanları da dikkate almak gerek. O kontrolü siz yaparsınız artık
• T2 deki formülü de =ETARİHLİ(S2;BUGÜN();"Y") olarak kullanınız.

Private Sub Workbook_Open()

    Dim i   As Long
    Dim Adt As Integer
    Dim s1  As Worksheet
    Dim Mes As String
    
    Mes = "BUGÜN DOĞANLAR....." & Chr(10) & "-------------------"
    
    Set s1 = Sheets("Sayfa1")
    
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
        If Month(Cells(i, "S")) = Month(Date) And Day(Cells(i, "S")) = Day(Date) Then
            Mes = Mes & Chr(10) & Cells(i, "B") & " " & Cells(i, "D") & " " & Cells(i, "E")
            Adt = Adt + 1
        End If
    Next i
    
    If Adt = 0 Then
        MsgBox "Bugün Doğum Günü Olanlar Yok..."
    Else
        MsgBox Mes
    End If
    
End Sub

 

[Necdet]

Kod işe yaramadı mı?

 

[Researcher]

Sn. Necdet Yeşertener

dediğinizi yaptım, t2 deki formülü de değiştirdim. kodu yaptım visual basic te f5 ile çalışıyor kayıt edip çıkıyorum. ama excel dosyasını açtığımda açılışta gelmiyor ekran

 

[Merhum İdris SERDAR]

Sn. Necdet Yeşertener

dediğinizi yaptım, t2 deki formülü de değiştirdim. kodu yaptım visual basic te f5 ile çalışıyor kayıt edip çıkıyorum. ama excel dosyasını açtığımda açılışta gelmiyor ekran

.

Sayın Necdet beyin kodları ile dosyanız ekte.


.