• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listbox Checkbox olayı

yusuf1284

Altın Üye
Katılım
17 Ocak 2015
Mesajlar
232
Excel Vers. ve Dili
Office Pro 2016 TR
Aşağıda yer alan kod ile checkbox tıklandıkça işlem yapmak istiyorum ama listbox tıklamaları algılamıyor. Konu hakkında bilgisi olan var mı?


C++:
Private Sub lst_2_Click()
    BasliklariGetir
End Sub
Sub BasliklariGetir()
    Dim ws As Worksheet
    Dim rng As Range
    Dim dataArr As Variant
    Dim sortedList() As String
    Dim selectedItems() As String
    Dim unselectedItems() As String
    Dim i As Long, j As Long, countSelected As Long, countUnselected As Long
    Dim searchValue As String
    Dim currentItem As String
    
    Application.EnableEvents = False
    
    ' Çalışma sayfasını belirleyin ve verileri aralığından diziye aktarın
    Set ws = ThisWorkbook.Worksheets(db_pb.Name)
    Set rng = ws.Range("E6:HI6")
    dataArr = rng.Value
    
    ' TextBox değerini al ve küçük harfe dönüştür
    searchValue = LCase(txtBaslikAra.Value)
    
    ' Seçili öğeleri ayırmak için diziler oluştur
    countSelected = 0
    countUnselected = 0
    ReDim selectedItems(1 To 1)
    ReDim unselectedItems(1 To UBound(dataArr, 2))
    
    ' ListBox'ta seçili olan öğeleri al
    For i = 0 To lst_2.ListCount - 1
        If lst_2.Selected(i) Then
            countSelected = countSelected + 1
            If countSelected > 1 Then ReDim Preserve selectedItems(1 To countSelected)
            selectedItems(countSelected) = lst_2.List(i)
        End If
    Next i
    
    ' Hücrelerdeki veriler üzerinde işlem yap
    For i = LBound(dataArr, 2) To UBound(dataArr, 2)
        If Not IsEmpty(dataArr(1, i)) Then
            currentItem = CStr(dataArr(1, i))
            If InStr(1, LCase(currentItem), searchValue) > 0 Or searchValue = "" Then
                If Not IsItemInArray(currentItem, selectedItems, countSelected) Then
                    countUnselected = countUnselected + 1
                    unselectedItems(countUnselected) = currentItem
                End If
            End If
        End If
    Next i
    
    ' Eğer seçili öğe yoksa, diziyi sıfırlama
    If countSelected = 0 Then
        Erase selectedItems ' Seçili öğeler yoksa diziyi sıfırla
    End If
    
    ' Eğer arama sonucu uyuşan değer yoksa, unselectedItems dizisini sıfırlama
    If countUnselected > 0 Then
        ReDim Preserve unselectedItems(1 To countUnselected)
    Else
        Erase unselectedItems ' Eğer arama sonucu uyuşan değer yoksa sıfırlama
    End If
    
    ' Dizileri birleştir
    ReDim sortedList(1 To countSelected + countUnselected)
    
    ' Seçili öğeleri önce sırasıyla, ardından diğer öğeler
    For i = 1 To countSelected
        sortedList(i) = selectedItems(i)
    Next i
    For j = 1 To countUnselected
        sortedList(countSelected + j) = unselectedItems(j)
    Next j
    
    ' ListBox'u doldur
    lst_2.Clear
    For i = 1 To UBound(sortedList)
        lst_2.AddItem sortedList(i)
    Next i
    
    ' Seçili öğeleri tekrar seçili hale getirme
    For i = 0 To lst_2.ListCount - 1
        For j = 1 To countSelected
            If lst_2.List(i) = selectedItems(j) Then
                lst_2.Selected(i) = True
            End If
        Next j
    Next i
    Application.EnableEvents = True
End Sub

Private Function IsItemInArray(item As String, arr() As String, count As Long) As Boolean
    Dim i As Long
    For i = 1 To count
        If LCase(arr(i)) = LCase(item) Then
            IsItemInArray = True
            Exit Function
        End If
    Next i
    IsItemInArray = False
End Function
 
Geri
Üst