مساعدة في الذهاب إلى مواضع معينة في القائمة (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

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

[nssj]

جزاك الله خيرا أخي الكريم

11 ساعات مضت, Foksh said:

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

نعم يمكن أن يتكرر، والخطأ مني حيث أني لم أنبه أن الانتقال سيكون بالاعتماد على القيمة التي لا تتكرر وهي رقم (Msno) وهي في القائمة: (Column(0

11 ساعات مضت, Foksh said:

الزر مصدر تسميته هل هو متغير ؟

لم أفهم مقصدك أخي الكريم

على العموم .. أعجبتني فكرة أن يكود الكود وحدة نمطية لاستدعائها من أكثر من نموذج

بل حتى في النموذج الواحد سيكون هناك أكثر من (10) أزرار أوامر لنفس الغرض فلا داعي لتكرار الكود: (أنس – جابر – سعد – بن عباس – بن عمر – بن مسعود – علي – عمر – معاذ – أبو هريرة – عائشة – مبهم – مرسل) وفي كل زر سأضع أنا رقم (Msno) المطلوب الانتقال له في القائمة

وقد جربت الأكواد الثلاثة التي تفضلت بها أخي الكريم بعد أن نجحت في تعديلها لتعمل عبر (Msno)

ووضعت في الملف المرفق ثلاثة أزرار لكل زر كود، وتم المطلوب

وأترك لك أخي الكريم اللمسة النهائية باختيار أحد هذه الأكواد وتعديله وتحويله لوحدة نمطية، بعد أن علمتَ أن الانتقال سيكون إلى رقم فريد وليس نصا يمكن أن يتكرر

مع التذكير بالكود الذي ينتقل لآخر القائمة (go_Last)

LIST1.accdb

[Foksh]

24 دقائق مضت, nssj said:

نجحت في تعديلها لتعمل عبر (Msno)

ووضعت في الملف المرفق ثلاثة أزرار لكل زر كود، وتم المطلوب

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

ما شاء الله عليك ، أبدعت في تحوير الأفكار لما يتناسب مع مطلبك 

بما انك ستقوم بتضمين الرقم الفريد في الأكواد ، بدلاً من التسمية للزر . جرب هذا التعديل على المديول ليصبح أبسط قليلاً ..

Public Sub SelectByMSNO(frm As Form, listName As String, msno As Long)
    Dim lb As ListBox
    Dim i As Long
    
    Set lb = frm.Controls(listName)
    
    If lb.ListCount = 0 Then
        MsgBox "القائمة فارغة", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    For i = 0 To lb.ListCount - 1
        If Nz(lb.Column(0, i), 0) = msno Then
            lb.Value = lb.ItemData(i)
            Exit Sub
        End If
    Next i
    
    MsgBox msno & " :لم يتم العثور على السجل", vbInformation + vbMsgBoxRight, ""
End Sub

 

وبنفس الأسلوب ، سيتم الاستدعاء بتمرير النموذج الحالي ، واسم الليست بوكس ، والرقم الفريد فقط ( كما فعلت في فكرتك وتعديلك الجميل 

 

SelectByMSNO Me, "Msaneed_List", 786

 

وما شاء الله عليك ، لن تحتاج لملف مرفق 

[nssj]

شكراً على إطرائك أخي الكريم 😊

الكود يؤدي المطلوب بحمد الله

وحتى ننهي الموضوع .. ما هو الأمر المطلوب لينتقل المؤشر إلى آخر القائمة

أنا كنت أظن أن هناك أوامر بسيطة مباشرة خاصة للانتقال لأول وآخر القائمة على شاكلة:

DoCmd.GoToRecord , "", acLast

ولكن يبدو أن الأمر ليس كذلك

[Foksh]

3 دقائق مضت, nssj said:

ما هو الأمر المطلوب لينتقل المؤشر إلى آخر القائمة

ولا يهمك ،، الأمر مختلف قليلاً فعلاً ، ولكن ليس بالتعقيد الذي تعتقده

للإنتقال لأول قيمة في الليست بوكس :-

    If Me.Msaneed_List.ListCount > 0 Then
        Me.Msaneed_List.Value = Me.Msaneed_List.ItemData(0)
    End If

 

وللإنتقال لآخر قيمة في الليست بوكس :-

    If Me.Msaneed_List.ListCount > 0 Then
        Me.Msaneed_List.Value = Me.Msaneed_List.ItemData(Me.Msaneed_List.ListCount - 1)
    End If

 

[nssj]

جزاك الله خيرا أخي الكريم وأحسن إليك

تم المطلوب بحمد الله

[Foksh]

4 دقائق مضت, nssj said:

تم المطلوب بحمد الله

بفضل الله ، وله الحمد