اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طلب مساعدة في تصحيح كود البحث حتى يقوم بالبحث في كل الصفحات


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

بسم الله الرحمن الرحيم

السادة الأفاضل مسئولي ومشرفي ورواد المنتدى الأفاضل :

تحية طيبة من عند الله ... وبعد

أرجوا من سيادتكم التكرم بمراجعة الكود التالي وتصحيح ما به من خطأ حتى يتم البحث في الملف من الشيت رقم 5 حتى نهاية الملف .

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

وبارك الله فيكم جميعا ولكم جزيل الشكر والتقدير مقدما

الكود هو

Private Sub TextBox1000_Change()
If TextBox1000.Value = "" Then ListBox1.Clear: Exit Sub
Dim x As Worksheet
ListBox1.Clear
k = 0
For Each x In ThisWorkbook.Worksheets
SS = x.Cells(Rows.Count, 10).End(xlUp).Row
For Each c In x.Range("D10:D" & SS)
b = InStr(c, TextBox1000)
If c Like TextBox1000.Value & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = Cells(c.Row, 4).Value
ListBox1.List(k, 1) = c.Row
k = k + 1
End If
Next c
Next x
End Sub

ومرفق الملف للتجربة والمعاينة عليه

برنامج_شئون_الطلاب_إصدار_تجريبي_للفروم_الجديد_18-4-2019.xlsm

رابط هذا التعليق
شارك

الكود صحيح عندك فقط عرض النتيجه في الليست بوكس 

 في السطر التالي لم تشير لمتغير الورقة

ListBox1.List(k, 0) = Cells(c.Row, 4)

بيكون بهذا الشكل

ListBox1.List(k, 0) = x.Cells(c.Row, 4)

 

رابط هذا التعليق
شارك

الأستاذ الفاضل المحرتم : الـعيدروس

تحية طيبة من عند الله

شكرا لاهتمام حضرتك والرد على طلبي

قمت بتنفيذ ما أفدت به حضرتك وبالفعل بحث في كل الصفحات ولكن هناك مشكلة بسيطة أنه عندما أضغط على اسم لإظهار بياناته في التكست بوكسات لا يعطيني البيانات الصحيحة وإلى حضرتك صورة مما يظهر .

أرجوا الإفادة من فضل وكرم أخلاق حضرتك .

وشكرا

نتيجة البحث.jpg

رابط هذا التعليق
شارك

السلام عليكم

اخي الكريم حاتم مشكور على كلماتك الطيبه

 هذه تعديلات على حدث Private Sub TextBox1000_Change()

Private Sub TextBox1000_Change()
If TextBox1000.Value = "" Then ListBox1.Clear: Exit Sub
Dim x As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
For Each x In ThisWorkbook.Worksheets
SS = x.Cells(Rows.Count, 10).End(xlUp).Row
For Each c In x.Range("D10:D" & SS)
b = InStr(c, TextBox1000)
If Trim(c) Like TextBox1000 & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = x.Cells(c.Row, 4)
ListBox1.List(k, 1) = c.Worksheet.Name
ListBox1.List(k, 2) = c.Row
k = k + 1
End If
Next c
Next x
End Sub

وحدث Private Sub ListBox1_Click()

Private Sub ListBox1_Click()
For I = 0 To ListBox1.ListCount
    If ListBox1.Selected(I) = True Then
        For j = 1 To 32
        Controls("TextBox" & j).Text = Sheets(ListBox1.List(I, 1)).Cells(ListBox1.List(I, 2), j)
        Next j
        r = ListBox1.List(I, 1)
        Exit For
    End If
Next I
End Sub

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

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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

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

Important Information