Kademeli Hatırlatma

[Barons]

Merhaba

Forumdan bulduğum aşağıdaki dosya, istenilen günde hatırlatma yapıyor ama verilen tarihe 3 gün kala hergün hatırlatmada bulunması mümkünmüdür? yani 3 gün kaldı,2 gün kaldı,1 gün kaldı ve son gün gibi.

Teşekkürler
Saygılar

 

[fedeal]

İstediginiz sırayla msj vermesimi eki inceleyin,

 

[Barons]

çok teşekkürler ama galiba mantığı ben ters kurdum sanırım.Ekli dosyada tarihleri değiştirdim.
Bugün 29 temmuz diyelim.Ayın 30,31 ve 1 ağustosda işler olsun...Bu işlerden ayın 30'unda olana 1 gün kaldı,31 inde olana 2 gün kaldı gibi...yani tam tersi.

çok teşekkürler

 

[fedeal]

pardon ben + yapacagıma - yapmışım düzelttim,

 

[abdi]

Edit Sayın Fedeal ( Benden önce Dosyayı Düzeltmiş Özür Diilerim.)

Doğru anladı isem Kodu aşağıdaki şekilde değiştirin this workbooktakini

Private Sub Workbook_Open()
On Error Resume Next                   'Hata varsa sonraki satıra geç
bulunan = ""                           'bulunan değişkenini sıfırla
bul = Range("B1:B1000").Find(Date + 3).Row 'bugünkü tarihe ait hatırlatma satırını bul.

If bul > 0 Then                        'eğer bir hatırlatma bulunur ise
    
    With Range("B1:B1000")              'b1:b100 alanı boyunca
    Set c = .Find(Date + 3)              'c ye arama sonucunu sabitle
    If Not c Is Nothing Then           'eğer arama sonucu olumlu ise
        firstAddress = c.Address       'ilk bulunanın adresini al
        Do
        
            bulunan = bulunan & Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
            'bulunan değerleri biriktir.
            
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        'kayıt bulunduğu ve bulunan adres ilk adresten farklı olduğu müddetçe
        'döngü devam etsin
        
    End If
    End With
   If bulunan = "" Then GoTo atla1
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler 3 GÜN KALANLAR"
'bulunanı mesaj olarak göster
End If
atla1:
'-----------------------------------------------------------------------------------------
On Error Resume Next                   'Hata varsa sonraki satıra geç
bulunan = ""                           'bulunan değişkenini sıfırla
bul = Range("B1:B1000").Find(Date + 2).Row 'bugünkü tarihe ait hatırlatma satırını bul.

If bul > 0 Then                        'eğer bir hatırlatma bulunur ise
    
    With Range("B1:B1000")              'b1:b100 alanı boyunca
    Set c = .Find(Date + 2)              'c ye arama sonucunu sabitle
    If Not c Is Nothing Then           'eğer arama sonucu olumlu ise
        firstAddress = c.Address       'ilk bulunanın adresini al
        Do
        
            bulunan = bulunan & Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
            'bulunan değerleri biriktir.
            
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        'kayıt bulunduğu ve bulunan adres ilk adresten farklı olduğu müddetçe
        'döngü devam etsin
        
    End If
    End With
    
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler 2 GÜN KALANLAR"
'bulunanı mesaj olarak göster
End If
'-------------------------------------------------------------------------------------------
On Error Resume Next                   'Hata varsa sonraki satıra geç
bulunan = ""                           'bulunan değişkenini sıfırla
bul = Range("B1:B1000").Find(Date + 1).Row 'bugünkü tarihe ait hatırlatma satırını bul.

If bul > 0 Then                        'eğer bir hatırlatma bulunur ise
    
    With Range("B1:B1000")              'b1:b100 alanı boyunca
    Set c = .Find(Date + 1)              'c ye arama sonucunu sabitle
    If Not c Is Nothing Then           'eğer arama sonucu olumlu ise
        firstAddress = c.Address       'ilk bulunanın adresini al
        Do
        
            bulunan = bulunan & Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
            'bulunan değerleri biriktir.
            
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        'kayıt bulunduğu ve bulunan adres ilk adresten farklı olduğu müddetçe
        'döngü devam etsin
        
    End If
    End With
    
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler 1 GÜN KALANLAR"
'bulunanı mesaj olarak göster
End If
'-------------------------------------------------------------------------------------------
On Error Resume Next                   'Hata varsa sonraki satıra geç
bulunan = ""                           'bulunan değişkenini sıfırla
bul = Range("B1:B1000").Find(Date).Row 'bugünkü tarihe ait hatırlatma satırını bul.

If bul > 0 Then                        'eğer bir hatırlatma bulunur ise
    
    With Range("B1:B1000")              'b1:b100 alanı boyunca
    Set c = .Find(Date)              'c ye arama sonucunu sabitle
    If Not c Is Nothing Then           'eğer arama sonucu olumlu ise
        firstAddress = c.Address       'ilk bulunanın adresini al
        Do
        
            bulunan = bulunan & Cells(c.Row, 1) & " --> " & c.Text & Chr(13)
            'bulunan değerleri biriktir.
            
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        'kayıt bulunduğu ve bulunan adres ilk adresten farklı olduğu müddetçe
        'döngü devam etsin
        
    End If
    End With
    
MsgBox bulunan, vbInformation, "Hatırlanması Gerekenler SON GÜN"
'bulunanı mesaj olarak göster
End If

End Sub

 

[Barons]

teşekkürler...şimdi olmuş

 

[Barons]

merhabalar
bu hatırlatma konusuna şöyle bir ilave olabilirmi?3 gün kala hatırlatmaya başlıyor bu çok güzel ancak yapılması gereken işlem yapılmamışsa günü geçsede hatırlatmaya devam edebilirmi?

teşekkürler

 

[Barons]

hergün "şu işleminiz tamamlanmadı" şeklinde uyarı....yani ne zaman işlem tamamlanırsa hatırlatmayı kesmeli şeklinde oalbilirmi?

 

[fedeal]

Merhaba,
Daha önce benzer bir çalışma yapmıştım ama bu daha pratik bu eklemyide yaptıkmı tamamen aynı işlevli olacak. Yanlız yapılan işleri c sütünuna girmelisiniz.
İyi çalışmalar.

 

[Barons]

Sn.Fedeal,
Çok teşekkürler.Tam istediğimde buydu zaten.