التحديد المتعدد في مربع القائمة و نقل المحدد لمربع قائمة اخر

تم وضع هذه الميزة فى برنامج اضافات الاكسس

/index.php?showtopic=231269&st=40

شكراً جزيلاً استاذ Abo_Yossof

ولكن البرنامج مغلق المصدر MDE

اليك اخى الفكرة

    Dim lItem As Long

    For lItem = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lItem) Then
            '**********
        End If
    Next lItem

استبدل النجوم بما تريد فعله

اقتباس

اليك اخى الفكرة

اقتباس

Dim lItem As Long

For lItem = 0 To Me.ListBox1.ListCount - 1

If Me.ListBox1.Selected(lItem) Then

'**********

End If

Next lItem

استبدل النجوم بما تريد فعله

اعتذر اخي Abo_Yossof

لم اعرف الطريقة يمكن تطبيقها لي على هذا المثال المعدل من قبلك وشكراً

اقتباس

اليك اخى الفكرة

اقتباس

Dim lItem As Long

For lItem = 0 To Me.ListBox1.ListCount - 1

If Me.ListBox1.Selected(lItem) Then

'**********

End If

Next lItem

استبدل النجوم بما تريد فعله

اعتذر اخي Abo_Yossof

لم اعرف الطريقة يمكن تطبيقها لي على هذا المثال المعدل من قبلك وشكراً

Users Maker MrNo Edition.rar

جرب هذا الكود

Dim lItem As Long 
    For lItem = 0 To Me.L1.ListCount - 1
      If Me.L1.Selected(lItem) = True Then
        L2.AddItem L1.ItemData(lItem)
        Me.L1.Selected(lItem) = False
      End If
    Next lItem

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

اخي ابو يوسف بارك الله فيك وشكرا لما تقدمه لإخوانك

اعرف أني أثقلت عليك

الكود السابق عمل بشكل ممتاز ولكن عند نقل البيانات من الليست 1 الى 2

لا يحذف البيانات المنقولة من اليست 1

===========

جربت هذا الكود و لكنه يحذف سجل واحد من السجلات المحددة

اقتباس

Dim lItem As Long

For lItem = 0 To Me.L1.ListCount - 1

If Me.L1.Selected(lItem) = True Then

L2.AddItem L1.ItemData(lItem)

L1.RemoveItem (L1.ItemData(lItem))

Me.L1.Selected(lItem) = False

End If

Next lItem

ارجو ان اجد عند حضرتك الكود الذي يحذف السجلات المحددة بعد نقلها من الليست 1 الى الليست 2

تفضل اخى

Dim strRemoveList As String
Dim astrRemoveItem() As String
Dim varItem As Variant
Dim lngI As Long

With Me.L1
For Each varItem In .ItemsSelected
L2.AddItem .ItemData(varItem)
strRemoveList = strRemoveList & Chr(0) & .ItemData(varItem)
Next varItem

If Len(strRemoveList) > 0 Then
astrRemoveItem = Split(Mid$(strRemoveList, 2), Chr(0))

For lngI = LBound(astrRemoveItem) To UBound(astrRemoveItem)
.RemoveItem astrRemoveItem(lngI)
Next lngI

End If
End With

شكرا استاذ ابو يوسف و بارك الله فيك

فعلا هذا هو المطلوب +1

(تم الإجابة على الموضوع)