اضافة بيانات رؤوس الاعمدة داخل الليست بوكس

[mahmoud nasr alhasany]

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

الرجاء مساعدتى

انها عملية بحث بين شرطين او اكثر اسم المخزن وكود الصنف والتاريخ اذا لزم الامر  واظهار النتائج فى الليست بوكس 2 وعند عملية البحث لايدرج بيانات رؤوس الاعمدة داخل الليست بوكس2 فما الخطاء فى الكود

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    
'  ' تعريف رؤوس الأعمدة وعروضها
'    colHeaders = Split("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
'    'colHeaders = Array("اسم المخزن", "كود", "صنف", "سعر", "كمية المخزون", "تاريخ نهاية الصنف")
    colWidths = "40;50;50;40;60;40"

    ' تهيئة ListBox2
    With ListBox2
        .Clear
        '.columnCount = UBound(colHeaders) + 1 ' عدد الأعمدة + 1 لرأس العمود
        .columnWidths = colWidths
        .columnCount = 6
        .Font.Size = 10
        .ColumnHeads = True
        ' تعيين رؤوس الأعمدة بشكل صريح (اختياري)
'        For i = 0 To UBound(colHeaders)
'       '     .List(.ListCount - 1, i) = colHeaders(i)
'       ListBox2.AddItem colHeaders(i)
'        Next i
    End With

    'ListBox2.Clear
    currentRow = 0

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
             ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 0 Then
        MsgBox "لم يتم العثور على نتائج"
    End If
End Sub

 

 

عملية بحث بشرطين او اكثر.xlsm

تم تعديل أكتوبر 20 بواسطه mahmoud nasr alhasany

[محمد هشام.]

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

جرب هدا 

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim colHeaders As Variant

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' تعريف رؤوس الأعمدة
    colHeaders = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    colWidths = "35;60;45;40;65;40"

    With ListBox2
        .Clear
        .ColumnCount = UBound(colHeaders) + 1
        .ColumnWidths = colWidths
        .Font.Size = 10
        .AddItem
        For i = 0 To UBound(colHeaders)
            .List(0, i) = colHeaders(i)
        Next i
    End With

    currentRow = 1

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 1 Then
        MsgBox "لم يتم العثور على نتائج"
    End If

    TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount - 1 & ")"
    
    Call TOtal
End Sub

 

[mahmoud nasr alhasany]

شكرا لك  محمد هشام.

الكود يعمل جيدا ولاكن اريد اظهار البيانات داخل رؤوس الاعمدة

ListBox2.ColumnHeads = True

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim colHeaders As Variant

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' تعريف رؤوس الأعمدة
    colHeaders = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    colWidths = "35;60;45;40;65;40"

    With ListBox2
        .Clear
        .ColumnCount = UBound(colHeaders) + 1
        .ColumnWidths = colWidths
        .Font.Size = 10
        .ColumnHeads = True
        .AddItem
        For i = 0 To UBound(colHeaders)
            .List(0, i) = colHeaders(i)
        Next i
    End With
    currentRow = 1

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 1 Then
        MsgBox "لم يتم العثور على نتائج"
    End If

    TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount - 1 & ")"
    
    Call TOtal
End Sub

 

تم تعديل أكتوبر 21 بواسطه mahmoud nasr alhasany

[محمد هشام.]

اخي @mahmoud nasr alhasany

 خاصية ColumnHeads = True في عنصر التحكم ListBox لا تعمل إلا إذا كانت البيانات مرتبطة مباشرة بنطاق خلايا من ورقة العمل باستخدام خاصية RowSource

عندما تستخدم الطريقة AddItem لإضافة البيانات يدويا لن يتم عرض رؤوس الأعمدة  حتى لو قمت بتعيين ColumnHeads = True

حاول إضافة رؤوس الأعمدة باستخدام عناصر Label بدلا من الاعتماد على رؤوس الأعمدة داخل الـ ListBox 

يمكنك تحديدها داخل كود تهيئة اليوزرفورم بعد اظافة عناصر label جديدة بعدد العناوين المرغوب عرضها وتسميتها بإسم مختلف لكي لا يتعارض الكود مع العناصر السابقة

مثلا (hrd1- hrd2-...-hrd6)

 

Private Sub UserForm_Initialize()
   'الكود الخاص بك
    Dim arr As Variant
    arr = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    For i = 1 To 6
        Me("hrd" & i).Caption = arr(i - 1)
    Next i
End Sub

وتعديل الكود على   Private Sub CommandButton1_Click()

  With ListBox2
        .Clear
        .ColumnCount = 6
        .ColumnWidths = colWidths
        .Font.Size = 10
    End With
    currentRow = 0
    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value ' كود
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ' صنف
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف
            currentRow = currentRow + 1
        End If
    Next i

 

عملية بحث بشرطين او اكثر.xlsm

[mahmoud nasr alhasany]

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

وجزاك الله عنا خير الجزاء

وهذا الكود بعد اضافة خيار التاريخ اذا لزم الامر

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim DateMin As Date
    Dim DateMax As Date
    Dim includeDates As Boolean

    ' تحديد ورقة العمل
    Set ws = Worksheets("Sheet3")

    ' الحصول على القيم من عناصر التحكم
    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value
    If IsDate(TextBox1.Value) Then DateMin = CDate(TextBox1.Value)
    If IsDate(TextBox2.Value) Then DateMax = CDate(TextBox2.Value)
    includeDates = CheckBox1.Value ' تحديد قيمة مربع الاختيار

    ' تحديد الصف الأخير
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' مسح قائمة النتائج وتحديد عرض الأعمدة
    With ListBox2
        .Clear
        .ColumnCount = 6
        .ColumnWidths = "35;60;45;40;65;40"
        .Font.Size = 10
    End With

    ' البحث عن البيانات وتعبئة القائمة
    currentRow = 0
    For i = 2 To lastRow
        ' التحقق من الشروط
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" And _
           (Not includeDates Or (ws.Cells(i, 6) >= DateMin And ws.Cells(i, 6) <= DateMax)) Then

            ' إضافة البيانات إلى القائمة
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن
            'ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف
            ListBox2.List(currentRow, 5) = Format(ws.Cells(i, 6).Value, "dd/mm/yyyy") ' تاريخ نهاية الصنف
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 0 Then
        MsgBox "لم يتم العثور على نتائج"
    End If
    
        TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount & ")"
        Call TOtal
    
End Sub