listbox(sıralama,seçili satırı silme),msgbox boş geçmeyin uyarısı

[peleryn]

Herkese Merhabalar;

Ekli dosyamda Evren hocamın,Necdet hocamın,Sn meslan'ın ...ve forumda paylaşımda bulunmuş birçok kişinin katkıları var.Hepsine tekrar teşekkür ediyorum.

Dosyada biraz farklı bir randevu sistemi uygulaması var.İnceleyince anlaşılacağını düşündüğümden açıklamıyorum.

Randevu kaydının büyük bölümünü hallettim sadece boş geçilen kutucukların msgboxla uyarılmasını halledemedim.Bir de iptal olan randevuları silmem gerekiyor.Bununla ilgili sorunumu da UserForm3 ün üzerinde açıkladım.

İlgilenecek olanlara şimdiden teşekkür ediyorum.

NOT:Randevu girişi yapmak isterseniz.2009 yılı için Kasım ayından öncesini denemeyin.

 

[Korhan Ayhan]

Selamlar,

Uyarı mesajı için aşağıdaki kodu kullanabilirsiniz.

Eski kodunuz;

If ComboBox5.Value = "" Then Exit Sub
If ComboBox3.Value = "" Then Exit Sub

Yeni Hali;

If ComboBox5.Value = "" Then
MsgBox "Tarih kutusu boş !"
ComboBox5.SetFocus
Exit Sub
End If
 
If ComboBox3.Value = "" Then
MsgBox "Saat kutusu boş !"
ComboBox3.SetFocus
Exit Sub
End If

Sıralama işlemi;

Private Sub isimler_Change()
Dim hcr As Range, x As Long
liste.Clear
For Each hcr In Range("C2:J1523")
    If UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ")) = _
    UCase(Replace(Replace(isimler, "ı", "I"), "i", "İ")) Then
    liste.AddItem
    liste.List(x, 0) = Format(Cells(hcr.Row, "A").Value, "dd.mm.yyyy")
    liste.List(x, 1) = Cells(hcr.Row, "B").Value
    liste.List(x, 2) = Cells(1, hcr.Column).Value
    x = x + 1
    End If
Next
listeler = liste.List
liste.List = sirala(listeler, 0)
End Sub

 

[peleryn]

Korhan hocam kodları düzelttim gayet güzel oldu herşey yerli yerine oturdu sayenizde.Bir tek listboxta seçili olan randevunun silinmesi kaldı.
Hızlı yanıtınız sayesinde rahat bir uyku uyuyabileceğim bunun için de ayrıca teşekkür etmeliyim sanırım
Yardımınız için teşekkürler..

 

[Korhan Ayhan]

Selamlar,

Kayıt silmek için aşağıdaki kodu kullanabilirsiniz.

Private Sub liste_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim BUL As Range, X As Byte
    
    If liste.ListCount = 0 Then Exit Sub
    
    Set BUL = Range("A:A").Find(CDate(liste.Column(0)))
    If Not BUL Is Nothing Then
    
    For X = 3 To 10
        If Cells(1, X) = liste.Column(2) Then
        Cells(BUL.Row, X).ClearContents
        isimler_Change
        Exit For
        End If
    Next
    
    End If
End Sub

 

[peleryn]

Korhan hocam çok teşekkür ederim sizin de desteğinizle problemlerim halloldu ve randevu formum çalışır hale geldi.
Ayrıca emeği geçen herkese de tekrar teşekkür ediyorum.

Öneridiğiniz kodların eklendiği son hali ilgilenecek olanlar için ektedir.