المساعدة في تكملة اكواد اليوزرفورم للادارج

[yasse.w.2010]

الاساتذه الكرام

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

لقد صممت هذا الفروم علي قدر معرفتي واطمع في كرمكم لتكملته

شاكر لكم جدا

 

فورم ادخال بيانات ديناميكى (1).xlsm

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

ربما يكون المطلوب

Option Explicit
Dim ws As Worksheet
Dim lr%, i%
Sub First_Of_all()
Set ws = ActiveSheet
lr = ws.Cells(Rows.Count, 2).End(3).Row
End Sub
'+++++++++++++++++++++++++++++++++++++++
Private Sub Cmd_Saech_Click()
Dim Arr(5), Itm, FR As Range
Arr(0) = "T_B": Arr(1) = "T_C":: Arr(2) = "T_D"
Arr(3) = "T_E": Arr(4) = "T_F": Arr(5) = "T_G"
First_Of_all
If Me.Where = vbNullString Or _
 Val(Me.Where) <= 0 Then
 MsgBox "Please Type Correct Number"
 Exit Sub
End If

Set FR = ws.Range("A8:a" & lr) _
.Find(CInt(Me.Where), lookat:=1)
If FR Is Nothing Then
    MsgBox "No data"
Else
    With ws.Cells(FR.Row, 2)
      For i = 0 To UBound(Arr)
      Me.Controls(Arr(i)) = .Offset(, i)
      Next
    End With
End If
End Sub

'+++++++++++++++++++++++++++++++++
Private Sub Cmd_Tarhil_Click()
Dim CTr As Control, Bol As Boolean
Dim Arr(5), Itm
Arr(0) = "T_B": Arr(1) = "T_C":: Arr(2) = "T_D"
Arr(3) = "T_E": Arr(4) = "T_F": Arr(5) = "T_G"

First_Of_all
For Each CTr In Me.Controls
If CTr.Name Like "T_*" _
 And CTr = vbNullString Then
  Bol = True: Exit For
 End If
Next
If Bol Then
   MsgBox "Please Fill all TextBoxes To countinous"
   Exit Sub
End If

With ws.Cells(lr + 1, 2)
 For i = 0 To UBound(Arr)
  .Offset(, i) = Me.Controls(Arr(i))
  Me.Controls(Arr(i)) = vbNullString
 Next
End With

MsgBox "That's ALL", vbInformation, "ADmin"
Unload Me
End Sub

yasse.w.xlsm

[yasse.w.2010]

الف شكر لحضرتك يا استاذ سليم 

ممكن بس تفعل زر الحذف بحيث يحزف الموجود في الشيت

وارجو من حضرتك صيغة التاريخ yyyy/mm/dd

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

تم تفعيل زر الحذف مع ادراج التاريخ بالتنسيق كما تريده

Private Sub Cmd_Del_Click()
First_Of_all
Dim FR As Range

If Val(Me.Where) <= 0 Then
Else
    Set FR = ws.Range("A8:A" & lr) _
    .Find(CInt(Me.Where), lookat:=1)
    If FR Is Nothing Then
        MsgBox "I can't Find That " _
        & """" & Me.Where & """" & " In Column A"
        Exit Sub
    Else
        ws.Cells(FR.Row, 1).Resize(, 7).Delete
        lr = ws.Cells(Rows.Count, 2).End(3).Row
        ws.Range("a10").Resize(lr - 9) = _
        Evaluate("Row(1:" & lr - 9 & ")")
    End If
    
  Me.Where = CInt(Me.Where)
End If

End Sub

yasse.w._1.xlsm

[yasse.w.2010]

الف شكر لحضرتك يا استاذ سليم علي مجهودك وتعب حضرتك

الفورم شغال اكثر من رائع

بس ارجو من حضرتك

ارجو من حضرتك عند الضغط على حذف يتم مسح البيانات من الخليه مسح البيانات بداخل الصف وليس حذف الصف ويترك الصف فارغ كما هوه

حذف البيانات فقط من B الى G فقط وليس كامل الصف

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

وقد وضعت الملف في المرفقات

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

وشكرا منتداي الغالي اوفسينا

yasse.w._22.xlsm

[Ali Mohamed Ali]

أحسنت استاذ سليم عمل ممتاز بارك الله فيك وجعله الله فى ميزان حسناتك

الأمر بسيط yasse.w.2010

عليك بتغيير هذا الصف من كود الحذف

ws.Cells(FR.Row, 1).Resize(, 7).Delete

واستبداله بهذا

ws.Cells(FR.Row, 1).Resize(, 7).ClearContents

 

[yasse.w.2010]

الف شكر استاذنا استاذ علي 

تم نسخ الكود ويعمل جيدا 

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

شكرا لكم على المجهود الرائع وادعو من الله يجعله في ميزان حسناتكم

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

للتعديل قم بتسمية زر التعديل بـــ      Cmd_UPdate    كما في الصورة

الكود اللازم

Private Sub Cmd_UPdate_Click()

Dim Arr(5), Itm, FR As Range
Arr(0) = "T_B": Arr(1) = "T_C":: Arr(2) = "T_D"
Arr(3) = "T_E": Arr(4) = "T_F": Arr(5) = "T_G"
First_Of_all
If Me.Where = vbNullString Or _
 Val(Me.Where) <= 0 Then
 MsgBox "ادخل رقم تاكيد الحجز"
 Exit Sub
End If

Set FR = ws.Range("A8:A" & lr) _
.Find(CInt(Me.Where), lookat:=1)
If FR Is Nothing Then
    MsgBox "No data"
Else
    With ws.Cells(FR.Row, 2)
      For i = 0 To UBound(Arr)
      .Offset(, i) = Me.Controls(Arr(i))
      Next
    End With
End If

 

[yasse.w.2010]

الف الف شكر استاذ سليم الكود يعمل بكفائه 

مش جديد علي حضرتك من كرم اخلاق ربنا يجعله في ميزان حسناتك

والف شكر للاستاذ علي

وخالص شكري لمنتدانا الغالي اوفسينا

باقي اخر تعديل

وهوه عند عملية تعديل علي البيانات يظهر التاريخ معكوس كالتالي YYYY/DD/MM الشهور في مكان الايام في اليست بوكس بتاع تاريخ الدخول و الخروج

ارجو عمله مثل الزر الخاص بترحيل البيانات بنفس الصيغة

وشاكر على تعبك جدا يا استاذ سليم

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

المشكلة عندك في الجهاز 

يجب تغيير نظام التاريخ فيه الى   yyyy/mm/dd

 

 

[yasse.w.2010]

الف شكر استاذ سليم 

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