مساعدة في الذهاب إلى مواضع معينة في القائمة (ListBox)

[nssj]

الإخوة الكرام .. هل يمكن التنقل في القائمة باستخدام الأكواد؟

يعني في الملف المرفق أريد عند الضغط على مربع (ابن عباس) ينتقل التحديد إلى ( عبد الله بن عباس)

حاولت بعدة طرق   منها:

Me.Msaneed_List.Recordset.FindFirst "TNO=798"

وأفضل ما وصلت إليه باستخدام كود

Me.Msaneed_List.RowSource = "SELECT Tab_Msaneed.MSno,Tab_Msaneed.MS_NAMEX FROM Tab_Msaneed WHERE ((Tab_Msaneed.TNO) > 798) ORDER BY Tab_Msaneed.Tno;"

وهو يجعل القائمة تبدأ من (ابن عباس)، وأنا أريد أن ينتقل إليه لا أن يبدأ منه، بحيث يمكنني استعراض ما قبله وما بعده.

وكذلك هل يمكن إنشاء كود يعمل تماماً مثل استخدام مفتاحي (Ctrl+Home // Ctrl+End ) بحيث ينتقل المؤشر لأول أو آخر القائمة ؟

LIST.accdb

[Foksh]

3 ساعات مضت, nssj said:

الإخوة الكرام .. هل يمكن التنقل في القائمة باستخدام الأكواد؟

 

وعليكم السلام ورحمة الله وبركاته ..

بداية لي عدة استفسارات مهمة :-

1. هل يوجد في الليست بوكس قيم قد تتشابه ، يعني لنفترض جدلاً هل القيمة "ابن عباس" قد تتكرر بأكثر من تسميةمختلفة ؟؟؟
2. الزر مصدر تسميته هل هو متغير ؟

على العموم ، سأقدم لك فكرتين ,,

الأولى بسيطة وتتعامل مع السجلات البسيطة إلى حد ما ( بطيئة مع السجلات الكثيرة جداً )

Private Sub Goms5_Click()
    Dim i As Long
    Dim searchText As String
    Dim colIndex As Integer

    searchText = Me.Goms5.Caption
    colIndex = 1

    For i = 0 To Me.Msaneed_List.ListCount - 1
        Me.Msaneed_List.Selected(i) = False
    Next i

    For i = 0 To Me.Msaneed_List.ListCount - 1
        If InStr(1, Me.Msaneed_List.Column(colIndex, i), searchText, vbTextCompare) > 0 Then
            Me.Msaneed_List.Selected(i) = True
            Exit For
        End If
    Next i
End Sub

 

الثانية تعتمد على اسلوبين + لو كان هناك أكثر من قيمة مطابقة يتم التنقل بينها عند كل نقرة على الزر ..

Private Sub Goms5_Click()
    Static lastIndex As Long
    Dim s As String, i As Long
    Dim matches As Collection
    Set matches = New Collection

    s = Trim(Nz(Me.Goms5.Caption, ""))
    If s = "" Then Exit Sub

    With Me.Msaneed_List
        For i = 0 To .ListCount - 1
            If InStr(1, Nz(.Column(1, i), ""), s, vbTextCompare) > 0 Then
                matches.Add i
            End If
        Next i

        If matches.Count = 0 Then
            MsgBox " : لم يتم العثور على" & s, vbInformation + vbMsgBoxRight, ""
            Exit Sub
        End If

        Dim pos As Long
        pos = 1

        If lastIndex > 0 Then
            For i = 1 To matches.Count
                If matches(i) = lastIndex Then
                    pos = IIf(i = matches.Count, 1, i + 1)
                    Exit For
                End If
            Next i
        End If

        .Value = .ItemData(matches(pos))
        lastIndex = matches(pos)
    End With
End Sub

 

ويمكن الإستفادة من الفكرة في أكثر من نموذج أو أزرار ضمن نفس النموذج بجعلها دالة عامة يتم استدعائها من خلال تحديد اسم الزر واسم الليست بوكس . بحيث في مديول منفصل ، نستخدم الدالة التالية :-

Option Compare Database
Option Explicit

Private dictLastIndex As Object

Public Sub SelectNextMatch(frm As Form, listName As String, searchText As String)
    Dim lb As ListBox
    Dim i As Long
    Dim matches As Collection
    Dim key As String
    Dim pos As Long, lastIndex As Long
    
    Set lb = frm.Controls(listName)
    
    searchText = Trim(Nz(searchText, ""))
    If searchText = "" Then Exit Sub
    
    If dictLastIndex Is Nothing Then
        Set dictLastIndex = CreateObject("Scripting.Dictionary")
    End If
    key = frm.Name & "|" & listName & "|" & searchText
    
    Set matches = New Collection
    For i = 0 To lb.ListCount - 1
        If InStr(1, Nz(lb.Column(1, i), ""), searchText, vbTextCompare) > 0 Then
            matches.Add i
        End If
    Next i
    
    If matches.Count = 0 Then
        MsgBox " : لم يتم العثور على" & searchText, vbInformation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    pos = 1
    If dictLastIndex.Exists(key) Then
        lastIndex = dictLastIndex(key)
        For i = 1 To matches.Count
            If matches(i) = lastIndex Then
                pos = IIf(i = matches.Count, 1, i + 1)
                Exit For
            End If
        Next i
    End If

ونستدعيها في الزرين على سبيل المثال ضمن نفس النموذج :-

Private Sub Goms5_Click()
    SelectNextMatch Me, "Msaneed_List", Me.Goms5.Caption
End Sub

Private Sub Goms10_Click()
    SelectNextMatch Me, "Msaneed_List", Me.Goms10.Caption
End Sub

الملف يحتوي على الأفكار الثلاثة :-

 

LIST.zip

تم تعديل منذ 9 ساعات بواسطه Foksh
إضافة ملف مرفق