Bilgisayarın tarihine ve exceldeki kilometreye göre hatırlatma

[yamahato]

Herkeze kolay gelsin

Ek'teki dosyamda içinden çıkamadığım bir kod eksiksiğim var .Şöyleki hatırlatmalar butonuna tıklayınca karşımıza hatırlatma girişi ve hatırlatma silme menüleri geliyor şimdi bu menülerde beceremediğim kısımlar şunlar

1-Hatırlatma girişinde butonlarımın hepsi çalışıyor.Burda sıkıntı şu TextBox lara gerekli bilgileri yazıp kaydet dediğimizde bilgiler yerine gidiyor.Bu bilgiler exceldeki hatırlatma sayfasına gidiyor.Userform11 diye birşey yaptım bunun amacı program her açıldığında ve belli zaman aralıklarında hatırlatma excel sayfasındaki bilgileri tarihi bilgisayarın tarihinden km ise şimdilik exceldeki bakım onarım bilgi deposundaki E sutunundan alarak beni ..... gün ve ..... kilometre kaldı şeklinde uyarmasıdır.Burda dikkat etmek için uğraştığım nokta şu hatırlatmanın yapıldığı plakanın en yüksek kilometresini almasıdır. Yani o plakaya ait kaçtane kayıt olursa olsun uyarmada o plakanın en yüksek kilometreyi alması gerekmektedir.

2-Hatırlatma silme menüsünde sıkıntı ise sil butonunun kodlarını ve ara butonunu kodlarını yazamadım.Aslında ara butonunun kodunu yazdım ama istediğim gibi olmadı.Plaka girilip ara dediğimizde hatırlatmalar excel sayfasındaki o plakaya ait en eski hatırlatma açısın istiyorum.Plaka değişmedikçe tekrar araya basınca o plakaya ait diğer hatırlatma çıkmalı ki ben silmek istediğim hatırlatmayı bulayım yada daha basit bir yol varsa oda olur.Sil tuşuna basınca o hatırlatma silinmeli ve excel sayfasındaki diğer hatırlatmaların s.nu 1 düşmeli ve son olarak o plaka ile ilgili hatırlatma yoksa hatırlatma bulunamadı yazmalı.

 

[yamahato]

İnşallah yardım eden olur .Saygılarımla

 

[yamahato]

bir yardımmm

 

[yamahato]

yardım yardım yardım

 

[yamahato]

güncel güncel güncel

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodları deneyiniz.

UserForm11;

Private Sub UserForm_Initialize()
    Dim S1 As Worksheet, X As Long, Satir As Long
    
    Set S1 = Sheets("HATIRLATMA")
    
    If S1.Range("A3") <> "" Then
    
        S1.Range("A3:E" & Rows.Count).Sort Key1:=S1.Range("B3"), Order1:=xlAscending, Key2:=S1.Range("E3"), Order2:=xlDescending
        
        With S1.Range("F3:F" & S1.Cells(Rows.Count, 1).End(3).Row)
            .FormulaR1C1 = "=COUNTIF(R3C[-4]:RC[-4],RC[-4])"
            .Value = .Value
        End With
        
        S1.Range("A3:F" & Rows.Count).Sort Key1:=S1.Range("A3"), Order1:=xlAscending
        
        ListBox1.ColumnCount = 4
        ListBox1.ColumnWidths = "80;170;80;80"
        
        For X = 2 To S1.Range("A65536").End(3).Row
            If S1.Cells(X, 4).Value <= Date And S1.Cells(X, 6) = 1 Then
                With ListBox1
                    .AddItem
                    .List(Satir, 0) = S1.Cells(X, 2).Text
                    .List(Satir, 1) = S1.Cells(X, 3)
                    .List(Satir, 2) = Date - S1.Cells(X, 4)
                    .List(Satir, 3) = Format(S1.Cells(X, 5), "#,##0.00")
                     Satir = Satir + 1
                End With
            End If
        Next
        
        S1.Range("F3:F" & Rows.Count).Clear
    End If
End Sub

UserForm9;

ARA butonu için;

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, BUL As Range
    
    Set S1 = Sheets("HATIRLATMA")
    S1.Select
    
    If TextBox1 = "" Then
        MsgBox "Lütfen plaka numarasını giriniz!", vbCritical
        TextBox1.SetFocus
        Exit Sub
    End If
    
    Set BUL = S1.Range("B:B").Find(CDbl(TextBox1), , , xlWhole)
    If Not BUL Is Nothing Then
        TextBox1 = BUL.Text
        TextBox2 = BUL.Offset(0, 2)
        TextBox3 = BUL.Offset(0, 1)
        TextBox4 = BUL.Offset(0, 3)
        BUL.Offset(0, -1).Select
    Else
        MsgBox "Aradığınız plaka bulunamadı!", vbCritical
        CommandButton3_Click
    End If
End Sub

SİL butonu için;

Private Sub CommandButton2_Click()
    Dim WF As WorksheetFunction
    
    Set WF = WorksheetFunction
    
    If TextBox1 = "" Then
        TextBox1.SetFocus
        Exit Sub
    End If
    If CDbl(TextBox1) = Cells(ActiveCell.Row, 2) Then
        Onay = MsgBox("Seçili kayıt silinecektir!" & Chr(10) & "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
        If Onay = vbNo Then Exit Sub
        ActiveCell.EntireRow.Delete
        Select Case WF.CountA(Range("A3:A" & Rows.Count))
            Case 1
                Range("A3") = 1
            Case Is > 1
                Range("A3") = 1
                Range("A3").AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(3).Row), Type:=xlFillSeries
        End Select
        CommandButton3_Click
    Else
        MsgBox "Kayıt eşleşmiyor. İşleminiz iptal edilmiştir!", vbExclamation
        CommandButton3_Click
    End If
End Sub

 

[yamahato]

Abicim eline sağlık teşekkür ederim
kodları yerlerine koydum .
Sil butonu çalışıyor.Sıkıntı yok.
Ara Butonu çalışıyor .fakat sadece 1 kere arıyor araya bastıkça o plakaya ait diğer hatırlatmaları bulmuyor
Hatırlatma için yazdığın userform11 kopyalanacak kodu da gerekli yere koydum ve denemek için tarihi yazdım ama hatırlatma olmadı birde km deneyim dedim oda olmadı saygılar.

 

[Korhan Ayhan]

Hatırlatma formunu açtığınızda sayfadaki bugünden küçük ya da eşit tarihleri dikkate alıp tüm kayıtları listeler. Hatırlatma formu otomatik çalışmamaktadır. Bir buton ile siz açacaksınız.