تعديل الأعمدة في الليست بوكس

[2saad]

اخواني اعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

في الملف المرفق فورم محتاج اعدل اتجاه الكتابة في الاعمدة في الليست بوكس بحيث تكون من اليمين الي الشمال مثل الشيت بالضبط

ولكم جزيل الشكرمحمد_2.xlsm

[محمد هشام.]

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

المشكلة ليست في الحل

اخي سعد طلبك ليس بالسهل يجب ان تعلم ان عكس اظهار البيانات على الليست بوكس يتطلب تعديل اكواد الترحيل والتعديل والحذف ...وهدا يلزمه بعض الوقت . 

Dim Col(), WSData, Largeur(), MyRng, ligne, F, ColSearch(), J

Private Sub UserForm_Initialize()
Dim A, B, C, D
' اسماء الجداول
    A = [Tableau1]: B = [Tableau2]: C = [Tableau3]: D = [Tableau4]
    ' التعامل مع ورقة العمل النشطة
  Set WSData = ActiveSheet
  ' نطاق البيانات
  Set MyRng = WSData.Range("C10:M" & WSData.[C65000].End(xlUp).Row)
  F = WSData.Range("C10:M" & WSData.[C65000].End(xlUp).Row).Value
  
  ' ترتيب الاعمدة الظاهرة على الليست بوكس
  Col = Array(11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
  ' عرض الاعمدة
  Largeur = Array(60, 50, 60, 80, 65, 75, 75, 80, 170, 50, 15)
  Me.ListBox2.ColumnCount = UBound(Col) + 1
  Me.ListBox2.ColumnWidths = Join(Largeur, ";")
  ' اظهار البيانات على الليست بوكس
  On Error Resume Next
  Me.ListBox2.List = Application.Index(MyRng, Evaluate("Row(1:" & MyRng.Rows.Count & ")"), Col)
  On Error GoTo 0
 'اعمدة خاصة بفلترة الليست بوكس
  ColSearch = Array(11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1) '  تم تحديد عمود اسم الطالب  (يمكنك تعديله)
  J = UBound(ColSearch) + 1
  'عناوين الليست بوكس
   Transférer
   Me.ListBox1.Visible = False
   Me.Show_file.Caption = "إظهار ملف العمل"
  ' رقم الصف
  ligne = WSData.[C65000].End(xlUp).Row + 1
  Me.N_Row = ligne
   ' عدد الصفوف على الجداول
   NbLigne = [Tableau1].Rows.Count + [Tableau2].Rows.Count + [Tableau3].Rows.Count + [Tableau4].Rows.Count
If Me.ComboBox1.Value = Empty Then Counter.Caption = "المجموع" & " / " & NbLigne Else Counter.Caption = Me.ComboBox1.Text & " / " & ListBox2.ListCount + 0
End Sub
'*******************************
Sub Transférer()
On Error Resume Next
i = 0
  For Each C In Col
      i = i + 1
  Me("MH" & i).Caption = MyRng.Offset(-1).Item(1, C)
    Next
End 
'******************************
Sub Search()
  students_name = "*" & Me.TextBox12 & "*"
  Dim Tbl(): n = 0
  For i = 1 To UBound(F)
    If F(i, 3) Like students_name Then  ' فلترة باسم الطالب
      n = n + 1: ReDim Preserve Tbl(1 To J, 1 To n)
      C = 0
      For Each k In ColSearch
        C = C + 1: Tbl(C, n) = F(i, k)
      Next k
    End If
  Next i
  If n > 0 Then Me.ListBox2.Column = Tbl Else Me.ListBox2.Clear
End Sub

 

محمد_3.xlsm

تم تعديل أكتوبر 30, 2023 بواسطه محمد هشام.

[2saad]

شكرا جزيلا يا أستاذ محمد