مطلوب اضافة امكانيه ترحيل بيانات من فورم بحث

[ehabaf2]

السلام عليكم السادة الافاضل

انا نزلت من الموقع فورم بحث عن البيانات

الفورم يقوم بالبحث فقط

فهل ممكن اضافة زر ترحيل البيانات يعني ادخل البيانات عن طريق الفورم

و اضافة زر تعديل و مسح

و لو المطلوب هياخد وقت كتير ممكن اضافة زر ترحيل فقط لانى محتاجه ضرورى

الف الف شكر لحضراتكم

مرفق الملف

ملف ترحيل بالفورم.xlsm

[محمد هشام.]

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

 بعد  إذن صاحب الملف أستادنا الكبير @ضاحي الغريب   

وتجنبا للتعديل على الأكواد الخاصة به  رغم أنني متأكد أنه تم التلاعب بها مسبقا

قمت بحدف جميع الأكواد الموجودة داخل اليوزرفورم وإعادة ترتيب  تسلسل عناصر TEXTBOX بما يتناسب مع شكل وتصمييم  الملف  وإنشاء أكواد جديدة بطريقتي الخاصة و إظافة بعض اللمسات  مع الاحتفاظ على نفس فكرة إشتغال اليوزرفورم   
 

تفضل اخي @ehabaf2 أتمنى أن يلبي طلبك  

Dim Btn(1 To 5) As New ClasseBoutons
Dim ExitLoop As Boolean
Const dict As Integer = 61
Private Const b  As Long = 1
Private Const SearchColumn As String = "A"
Public Property Get WS() As Worksheet: Set WS = Sheets("DATA"): End Property
Private Sub UserForm_Initialize()
  For i = 1 To 5
   Set Btn(i).GrBoutons = Me("commandbutton" & i)
  Next i
  Dim temp()
  Col = WS.Evaluate("SUM(0+(A5:A" & _
  WS.Cells(WS.Rows.Count, "A").End(xlUp).Row & "<>""""))")
  Set tbl = CreateObject("Scripting.Dictionary")
  For Each c In WS.Range("A4:A" & WS.[a65000].End(xlUp).Row)
    If c.Value <> "" Then tbl.Item(c.Value) = c.Value
  Next c
  temp = tbl.items
  Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox1.List = temp
  Me.limite.Value = Col
End Sub
'****************************
Private Sub ComboBox1_Change()  ' بجث وجلب البيانات
Dim fnd As Range, i As Long, sequence As String
sequence = Me.ComboBox1
If Len(sequence) = 0 Then Exit Sub
If IsNumeric(sequence) Then
     Set fnd = WS.Columns(SearchColumn).Find(sequence, , , xlWhole)
        If fnd Is Nothing Then
            MsgBox "! لم يتم العثور على رقم التسلسل " & " : " & _
            sequence & " " & "في قاعدة البيانات", 16, "تم ايقاف تنفيد الكود"
            Me.ComboBox1 = ""
       Exit Sub
       End If
       For i = 1 To dict
          Me.Controls("TextBox" & i).Value = fnd.Offset(, i - b).Value
       Next i
    End If
End Sub
'************************************
Private Sub CommandButton1_Click() ' ترحيل
    Dim i As Long, src As Range
    Set src = WS.Range("A" & WS.Rows.Count).End(xlUp)
    If Me.TextBox3 = "" Then: MsgBox "يرجى اظافة " & ":" & Me.Label2.Caption, 16: Exit Sub
    r = MsgBox("ترحيـل البيانات؟", vbYesNo, "تأكيـــد"): If r <> vbYes Then Exit Sub
    For i = 1 To dict
    Application.ScreenUpdating = False
    src.Offset(b, i - b).Value = Me.Controls("TextBox" & i).Value
    With WS.Range("A5:A" & WS.Cells(WS.Rows.Count, "C").End(xlUp).Row)
            .Value = Evaluate("ROW(" & .Address & ")-4")
    End With
        Me.Controls("TextBox" & i).Value = Null: Me.ComboBox1 = Empty
    Next i
    UserForm_Initialize
    Application.ScreenUpdating = True
End Sub
'********************************
Private Sub CommandButton3_Click()  'حدف
Dim sequence As String
sequence = Me.ComboBox1
If Len(sequence) = 0 Then Exit Sub
r = MsgBox("حدف البيانات؟", vbYesNo, "تأكيـــد"): If r <> vbYes Then Exit Sub
  Application.ScreenUpdating = False
  With WS
  For i = .[a65000].End(xlUp).Row To 5 Step -1
        If .Cells(i, (SearchColumn)) = sequence Then .Cells(i, 1).Resize(1, 61).Delete Shift:=xlUp
   Next i
            With Range("A5:A" & .Cells(.Rows.Count, "B").End(xlUp).Row)
                .Value = Evaluate("ROW(" & .Address & ")-4")
        End With
    End With
Clear_TextBox
Application.ScreenUpdating = True
UserForm_Initialize
End Sub
'********************************
Private Sub CommandButton2_Click()    ' تعديل
Dim fnd As Range, sequence As String
Dim i As Integer
sequence = Me.ComboBox1
If Len(sequence) = 0 Then Exit Sub
r = MsgBox("تعديل البيانات؟", vbYesNo, "تأكيـــد"): If r <> vbYes Then Exit Sub
Application.ScreenUpdating = False
Set fnd = WS.Columns(SearchColumn).Find(sequence, , , xlWhole)
For i = 1 To dict
WS.Cells(fnd.Row, i) = Controls("textbox" & i).Value
Next i
Clear_TextBox
Application.ScreenUpdating = True
UserForm_Initialize
End Sub

ملاحظة :  أكواد البحث و التعديل والحدف يتم تنفيدها بشرط عمود التسلسل / الترحيل بشرط وجود قيمة في Textbox رقم الموظف واي اظافة او تعديل لا تتردد في دكره سنكون سعداء دائما بحصولك على النتائج المتوقعة

لقد تركت لك إمكانية وضع توقيعك على اليوزرفورم 😃😃😃 بالتوفيق............

 

 

 

 

ملف ترحيل بالفورم V2.xlsm

تم تعديل أغسطس 18 بواسطه محمد هشام.

[ehabaf2]

الاستاذ الفاضل @محمد هشام.

الفورم يعمل بشكل رائع

و الله لا اجد كلمات شكر تعبر عن شكرى لشخصكم الكريم

الف الف شكر لحضرتك

ربنا يحفظك و يعزك و ييبارك فيك و يزيدك الله من فضله و علمه استاذنا الفاضل