ملف بجث في عدة اوراق

[ناصر سعيد]

ملف بحث في عدة اوراق

للعلامة عبد الله باقشير أعزه الله

بحث في الصفوف.rar

[ناصر سعيد]

ملف اخر للعلامه اعزه الله اكثر روعه

Dim V As Integer
Private Sub Check_Text_Click()
Kh_TextFind_Change
End Sub
Private Sub Comb_Find_Change()
Kh_TextFind_Change
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Kh_ListFind_Click()
Dim S_1 As String, S_2 As String
Dim MySh As Worksheet
S_1 = Kh_ListFind.List(Kh_ListFind.ListIndex, 1)
S_2 = Kh_ListFind.List(Kh_ListFind.ListIndex, 2)
Set MySh = Sheets(S_1)
With MySh
    .Select
    .Range(S_2).Select
End With
End Sub
Private Sub Kh_TextFind_Change()
On Error Resume Next
Dim MySh As Worksheet
Dim M As String
V = 0
Kh_ListFind.Clear
If Kh_TextFind.Text = "" Then GoTo 1
If Check_Text.Value = True Then M = Kh_TextFind.Text & "*" _
Else M = "*" & Kh_TextFind.Text & "*"
'==============================================================
Application.ScreenUpdating = False
If Comb_Find.ListIndex = 0 Then
    For Each MySh In ActiveWorkbook.Sheets
        Kh_Find MySh, M
    Next
Else
    Kh_Find Sheets(Comb_Find.ListIndex), M
End If
Application.ScreenUpdating = True
On Error GoTo 0
1 End Sub
Private Sub Kh_Find(MySheet As Worksheet, MyTextFind As String)
On Error Resume Next
Dim A
Dim R As Integer, C As Integer
With MySheet
    R = .UsedRange.Rows.Count
    C = .UsedRange.Columns.Count
    For Each A In Range(.Cells(1, 1), .Cells(R, C))
        If A.Value Like MyTextFind Then
            Kh_ListFind.AddItem A.Value
            Kh_ListFind.List(V, 1) = .Name
            Kh_ListFind.List(V, 2) = A.Address
            V = V + 1
        End If
    Next
End With
On Error GoTo 0
1 End Sub
Private Sub UserForm_Activate()
Dim C As Integer
Comb_Find.AddItem "بحث في جميع اوراق العمل"
For C = 1 To ActiveWorkbook.Sheets.Count
    Comb_Find.AddItem ActiveWorkbook.Sheets(C).Name
Next
Comb_Find.Text = Comb_Find.List(0)
End Sub

بحث و استيراد بيانات من ملف.rar