عمل برنامج ارشيف الملفات

[ahmad20]

السلام عليكم

اريد مساعدتكم في تصميم برنامج ارشيف الملفات حيث لدي اكثر من 500 موظف لكل موظف ملف احتفظ فيه بأي شي يخص كل موظف

واريد عند البحث باسم الموظف او رقمه تظهر لي النتيجة في مكان مخصص لذلك تم توضيحه بالملف المرفق

مقدما شكري لكم

ارشيف2019.xlsx

[وجيه شرف الدين]

اتفضل اخى الحبيب الملف لعله يفى بالغرض ولكن بتعديل بسيط فى الشيت حتى يكون البحث بالاسم او بالرقم من خلال خلية واحدة

نسخة من ارشيف2019.xlsx

[سليم حاصبيا]

تم ازالة بعض الخلايا المدمجة لحسن عمل الكود

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

واذا كان هناك خطأ يعطيك اشعاراً بذلك

الكود

Option Explicit
Private source_sh As Worksheet
Private Target_sh As Worksheet
Private Last_row%
Private RG_Source As Range
Private R1%
Rem =====>> created by Salim Hasbaya 13/7/2019
Sub Get_Data_By_name()
Set source_sh = Sheets("ورقة2")
Set Target_sh = Sheets("ورقة1")
Union(Target_sh.Range("D8"), Range("c12").Resize(, 5)).ClearContents
Last_row = Application.Max(source_sh.Range("D:D")) + 6
 Set RG_Source = source_sh.Range("b6:d" & Last_row)
   On Error Resume Next
 R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7")).Row
   On Error GoTo 0
   If R1 = 0 Then
   MsgBox "DATA nOT FOUND": Exit Sub
    Else
    With Target_sh
     .Range("C12") = .Range("D7")
     .Range("D8") = source_sh.Cells(R1, "C")
     .Range("F12") = .Range("D8")
     .Range("G12") = source_sh.Cells(R1, "D")
      End With
   End If
End Sub
Rem -------------------------------------------
Sub Get_Data_By_Index()
Set source_sh = Sheets("ورقة2")
Set Target_sh = Sheets("ورقة1")
Union(Target_sh.Range("D7"), Range("c12").Resize(, 5)).ClearContents
Last_row = Application.Max(source_sh.Range("D:D")) + 6
 Set RG_Source = source_sh.Range("b6:d" & Last_row)
   On Error Resume Next
 R1 = RG_Source.Columns(2).Find(Target_sh.Range("D8"), lookat:=xlWhole).Row
   On Error GoTo 0
   If R1 = 0 Then
   MsgBox "DATA NOT FOUND": Exit Sub
    Else
    With Target_sh
     .Range("D7") = source_sh.Cells(R1, "B")
     .Range("C12") = .Range("D7")
     .Range("F12") = .Range("D8")
     .Range("G12") = source_sh.Cells(R1, "D")
     
      End With
   End If
End Sub
Rem +++++++++++++++++++++++++++++

Private Sub Worksheet_Change(ByVal Target As Range)

 Application.EnableEvents = False
  If Target.Count = 1 Then
    Select Case Target.Address
         Case "$D$7": Get_Data_By_name
         Case "$D$8": Get_Data_By_Index
    End Select

  End If
 Application.EnableEvents = True

End Sub

 

Archive2019.xlsm

[ahmad20]

شكراً لكم جميعاً على ما قدمتموه لي

هذا ما اريد بالضبط

يعجز اللسان على شكركم ونفع الله بكم وبعلمكم وزادكم الله علماً

 

شكراً شكراً من الاعماق

[ahmad20]

ملاحظة مهمة ارجوا ان يتسع صدركم لها

عند البحث عن رقم قمت بكتابته خطا يظهر اخر اسم تم البحث عنه مع تغيير رقمه للمبحوث عنه

مثال :

لدي موظف اسمه احمد ابراهيم ورقمه 120 وكتبت بخانة البحث بالرقم 121 بالغلط يظهر لي اسم الموظف احمد ورقمه 121 ولو صححت الرقم الى 120 تظهر البيانات نفسها مع تغيير الرقم الى 120

اريد انه في حالة كتابة رقم موظف وهذا الرقم غير موجود يظهر خطا التأكد من الرقم

 

على هذا الملف Archive2019

[سليم حاصبيا]

استبدل هذا السطر في الكود

R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7")).Row

بهذا

 R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7"),Lookat:=Xlwhole).Row

Xlwhole     هنا حرف الـــ   L باللغة الانكليزية وليس رقم 1

اذا كان هذا الجواب الكود يفي بالغرض اضغط على افضل اجابة لإغلاق الموضوع

[وجيه شرف الدين]

جزاكم الله خير استاذ سليم انت انسان رائع جعله الله فى ميزان حسناتك