Listbox Checkbox olayı

[yusuf1284]

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ı?

Spoyler: Kodlar

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

 

[pitchoute]

Merhaba, şu şekilde dener misiniz;

Private Sub lst_2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    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
    
    ' Eğer olayları devre dışı bırakırsanız, MouseUp olayı tetiklenmeyebilir
    '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