تلوين ناتج البحث

[AMIRBM]

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

إخواني الكرام أطلب منكم مساعدة في تلوين ناتج البحث

وبارك الله فيكم

بحث في عدة أوراق مع التحديد 01.xlsm

[Foksh]

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

كفكرة بسيطة ، جرب تعديل هذا الحدث :-

Private Sub ListBox1_Click()

Sheets(ListBox1.Column(0)).Activate
Range(ListBox1.Column(1)).EntireRow.Select
TextBox2.Value = ListBox1.Column(2)

End Sub

 

الى التعديل التالي :-

Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    
    Sheets(ListBox1.Column(0)).Activate
    
    Cells.Interior.Pattern = xlNone
    
    With Range(ListBox1.Column(1))
        .Interior.Color = vbYellow
        .Activate
    End With
    
    TextBox2.Value = ListBox1.Column(2)
End Sub

 

قمت باختيار اللون الأصفر كمثال ، ولك الحرية بالتعديل على مزاجك 

[AMIRBM]

أستاذ بارك الله فيك وجزاك الله خيرا

لكن أستاذ أريد تلوين الصف وليس خلية مثلا 100 A4:F

تم تعديل منذ 3 ساعات بواسطه AMIRBM

[AMIRBM]

مشكورين

 

[Foksh]

2 ساعات مضت, AMIRBM said:

لكن أستاذ أريد تلوين الصف وليس خلية مثلا 100 A4:F

بسيطة أخي الكريم ..

تم التعديل الى الكود التالي :-

Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    
    Sheets(ListBox1.Column(0)).Activate
    
    Cells.Interior.Pattern = xlNone
    
    With Range(ListBox1.Column(1)).EntireRow
        .Interior.Color = vbYellow
        .Cells(1, 1).Activate
    End With
    
    TextBox2.Value = ListBox1.Column(2)
End Sub

 

[محمد هشام.]

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

 بعد إدن أستادنا الفاضل @Foksh

جرب إفراغ اليوزرفورم من جميع الأكواد السابقة ولصق الكود التالي ربما يناسبك

Private Sub UserForm_Initialize()
    ComboBox1.Clear: Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets: ComboBox1.AddItem sh.Name: Next
    ListBox1.ColumnCount = 3: ListBox1.ColumnWidths = "50;70;200"
End Sub
Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    Dim ShName As String, Addr As String
    ShName = ListBox1.List(ListBox1.ListIndex, 0)
    Addr = ListBox1.List(ListBox1.ListIndex, 1)
    Sheets(ShName).Activate: Cells.Interior.ColorIndex = xlNone
    With Sheets(ShName).Range("A" & Range(Addr).Row & ":F" & Range(Addr).Row)
        .Interior.Color = vbCyan: .Cells(1, 1).Activate
    End With
    TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 2)
End Sub
Private Sub TextBox1_Change()
    On Error GoTo Cleanup
    SetApp False
    Dim ws As Worksheet, Sh_Name As String, ky As String, LastRow As Long, LastCol As Long
    Dim OnRng As Variant, i As Long, j As Long, xCount As Long, CellAddress As String

    Sh_Name = ComboBox1.Value
    ky = Trim(TextBox1.Text)
    If Sh_Name = "" Or ky = "" Then
        ListBox1.Clear
        Label5.Caption = "عدد النتائج: 0"
        If Sh_Name <> "" Then Sheets(Sh_Name).Range("A:F").Interior.ColorIndex = xlNone
        Me.TextBox2 = ""
        GoTo Cleanup
    End If

    Set ws = Sheets(Sh_Name)
    With ws
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    End With

    ListBox1.Clear: ws.Range("A:F").Interior.ColorIndex = xlNone: xCount = 0
    OnRng = ws.Range(ws.Cells(4, 1), ws.Cells(LastRow, LastCol)).Value

    For i = 1 To UBound(OnRng, 1)
        For j = 1 To UBound(OnRng, 2)
            If InStr(1, OnRng(i, j), ky, vbTextCompare) > 0 Then
                xCount = xCount + 1
                CellAddress = ws.Cells(i + 3, j).Address(False, False)
                ListBox1.AddItem Sh_Name
                ListBox1.List(ListBox1.ListCount - 1, 1) = CellAddress
                ListBox1.List(ListBox1.ListCount - 1, 2) = OnRng(i, j)
                ws.Range("A" & (i + 3) & ":F" & (i + 3)).Interior.Color = vbCyan
                Exit For
            End If
        Next j
    Next i

    Label5.Caption = "عدد النتائج: " & xCount

Cleanup:
    SetApp True
End Sub
Private Sub UserForm_Terminate()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        sh.Range("A:F").Interior.ColorIndex = xlNone
    Next
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = "": ListBox1.Clear
End Sub
Private Sub ComboBox1_Change()
    On Error Resume Next
    If ComboBox1.ListIndex = -1 Then Exit Sub
    TextBox1 = "": ListBox1.Clear
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        sh.Range("A:F").Interior.ColorIndex = xlNone
    Next
    Sheets(ComboBox1.Value).Activate
End Sub
Private Sub SetApp(ByVal enable As Boolean)
    With Application
        .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable
        .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

ملاحظة :تم الاستغناء عن الكود Search_In_Sh() فأنت الآن لست بحاجة إليه

بحث في عدة أوراق مع التحديد v2.xlsm

تم تعديل منذ 1 ساعه بواسطه محمد هشام.