Liste Kutusu Sadece Sol Tık İle Çoklu Seçim Yapılsın

1 2
16/03/2020, 21:12

berduş

yada formdaki tüm kodları silip aşağıdakini yapıştırın
Option Compare Database
Option Explicit

Dim GSecili As String

Function basili(MButton As Integer)
Dim varItm As Variant
Dim i As Long

If MButton = 2 Then
GSecili = ""
For Each varItm In ActiveControl.ItemsSelected
GSecili = GSecili & "|" & varItm
Next varItm
GSecili = Mid(GSecili, 2)
End If

If MButton = acRightButton Then
CreateContextMenu CStr(ActiveControl.ItemsSelected.Count)
End If

End Function

Function Birak(MButton As Integer)
Dim i As Long
Dim SplitGSecili As Variant
If MButton = 2 Then
SplitGSecili = Split(GSecili, "|")
For i = 0 To ActiveControl.ListCount - 1
ActiveControl.Selected(i) = False
Next i
For i = LBound(SplitGSecili) To UBound(SplitGSecili)
ActiveControl.Selected(SplitGSecili(i)) = True
Next i
End If
End Function

Private Sub Metin3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
basili Button
End Sub

Private Sub Metin3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Birak Button
End Sub

Private Sub Metin4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
basili Button
End Sub

Private Sub Metin4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Birak Button
End Sub


Private Sub Metin5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
basili Button
End Sub

Private Sub Metin5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Birak Button
End Sub
16/03/2020, 21:23

berduş

eğer aşağıdaki kodları bir modüle eklerseniz herhangi bir formdan da çağırabilirsiniz
Modul kodu
Option Compare Database
Option Explicit

Dim GSecili As String

Function basili(frm As Form, MButton As Integer)
Dim varItm As Variant
    Dim i As Long

    If MButton = 2 Then
        GSecili = ""
        For Each varItm In frm.ActiveControl.ItemsSelected
            GSecili = GSecili & "|" & varItm
        Next varItm
        GSecili = Mid(GSecili, 2)
    End If
   
    If MButton = acRightButton Then
        CreateContextMenu CStr(frm.ActiveControl.ItemsSelected.Count)
    End If

End Function

Function Birak(frm As Form, MButton As Integer)
    Dim i As Long
    Dim SplitGSecili As Variant
    If MButton = 2 Then
        SplitGSecili = Split(GSecili, "|")
        For i = 0 To frm.ActiveControl.ListCount - 1
            frm.ActiveControl.Selected(i) = False
        Next i
        For i = LBound(SplitGSecili) To UBound(SplitGSecili)
            frm.ActiveControl.Selected(SplitGSecili(i)) = True
        Next i
    End If
End Function
liste kutusumouseDown fare basılırken kodu
    basili Form, Button
liste kutusumouseUp fare bırakılırken kodu
    Birak Form, Button
17/03/2020, 07:45

accessman

harika olmuş çok teşekkürler
17/03/2020, 08:13

berduş

Iyi calismalar
03/04/2021, 00:43

aliyorga

Güzel bir çalışma
1 2