اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

استاذي الكريم 

حاولت اخذ الكود من المشاركات السابقة ولكن لم تظبط معي 

ارجو من الاساتذه الكرام مساعدتي 

اريد كود اضيفه في ليظبط معي تنسيق التاريخ 

شاكر جدا لكم 

  • أفضل إجابة
قام بنشر

الكود كما يجب ان يكون (ثم ان اليوزر عريض بشكل لا تستطيع ان تراه بأكمله على الــ Vb Editor)
التقليل من عرضه و عرض الليست بوكس (مع اني لا أحب اليوزر ولا أطيق النعامل معه)

Private Sub CommandButton1()
Dim i As Long, s As Long, LF%
Dim Rg As Range
Dim Source As Worksheet
Dim Rg_to_find As Range
Dim Mot

For Each ctl In Me.Controls
      If TypeName(ctl) = "OptionButton" Then
         If ctl.Value = True Then
           Mot = ctl.Name
           Exit For
         End If
      End If
    Next ctl

Set Source = Sheets("القيود اليوميه 0")
 LF = Source.Cells(Rows.Count, "F").End(3).Row
 If LF < 9 Then Exit Sub
 
Select Case True
    Case Mot = "kod": Set Rg_to_find = Source.Range("C8:C" & LF)
    Case Mot = "mosm": Set Rg_to_find = Source.Range("D8:D" & LF)
    Case Mot = "Clirnt": Set Rg_to_find = Source.Range("F8:F" & LF)
    Case Mot = "pyan": Set Rg_to_find = Source.Range("H8:H" & LF)
    Case Mot = "Hot": Set Rg_to_find = Source.Range("G8:G" & LF)
    Case Mot = "madin": Set Rg_to_find = Source.Range("I8:I" & LF)
    Case Mot = "daen": Set Rg_to_find = Source.Range("J8:J" & LF)
    Case Mot = "snd": Set Rg_to_find = Source.Range("b8:b" & LF)
    Case Mot = "ced": Set Rg_to_find = Source.Range("A8:A" & LF)
    Case Else: Exit Sub
End Select
 
    With Me.ListBox1
      .AddItem
        For s = 0 To .ColumnCount - 1
         .List(.ListCount - 1, s) = Source.Cells(7, s + 1)
        Next
     End With
 For i = 8 To LF
      If UCase(Rg_to_find.Cells(i - 7)) Like ("*" & UCase(Mot) & "*") Then
           With Me.ListBox1
             .AddItem
              For s = 0 To .ColumnCount - 1
              .List(.ListCount - 1, s) = Source.Cells(i, s + 1)
              Next
           End With
      End If
 Next

End Sub

 

  • Like 1
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information