مساعدة وتعديل على كود حذف سجل

[الجموعي]

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

إفتراضي الكود عند الحذف يحذف الضف بأكمله

أنا أريد تقييد عند الحذف من العمود A إلى العمود F

If TextBox5.Text = "" Then
 MsgBox "قم اولا باختيار موظف لتعديله او حذفه", vbExclamation, "حذف"
Exit Sub
End If
Lastrow = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim Q
Q = MsgBox(" أنت على وشك حذف الاسم  " & "  (  " & TextBox2.Text & "  )  " & " من السجل ، هل تريد المواصلة ", vbCritical + vbYesNo, "تأكيد الحذف")
If Q = vbYes Then
    For i = 1 To 1
    For T = 1 To Lastrow
    If TextBox5.Text = ورقة1.Cells(T, 1) Then
 With ورقة1
.Cells(T, i).Value = ""
.Rows(T).delete Shift:=xlUp

Call delete

End With
    End If
    Next
    Next
    MsgBox "    لقد تم حذف الموظف من قاعدة البيانات   ", vbInformation, "إنهاء الحذف"

End If

تعديل على زر حذف.rar

[ياسر خليل أبو البراء]

الأخ الحبيب الجموعي

لو أرفقت ملف سيسهل على الجميع مساعدتك بالأمر .. تقبل تحياتي

[الجموعي]

 

الأخ الحبيب الجموعي

لو أرفقت ملف سيسهل على الجميع مساعدتك بالأمر .. تقبل تحياتي

 

 

شكرا أستاذي على الرد ظننت ان الامر سهل

معذرة مني استاذي

تم إرفاق الملف

[ياسر خليل أبو البراء]

قم بحذف هذا السطر

.Rows(T).delete Shift:=xlUp

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

.Range(Cells(T, 1), Cells(T, 6)).delete Shift:=xlUp

[الجموعي]

بارك الله فيك استاذي الفاضل

جزاك الله كل الخير

تم العملية بنجاح

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

كما في الصورة

 

 

ياريت تعديل على كود الحذف

If TextBox5.Text = "" Then
 MsgBox "قم اولا باختيار موظف لتعديله او حذفه", vbExclamation, "حذف"
Exit Sub
End If
Lastrow = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim Q
Q = MsgBox(" أنت على وشك حذف الاسم  " & "  (  " & TextBox2.Text & "  )  " & " من السجل ، هل تريد المواصلة ", vbCritical + vbYesNo, "تأكيد الحذف")
If Q = vbYes Then
    For i = 1 To 1
    For T = 1 To Lastrow
    If TextBox5.Text = ورقة1.Cells(T, 1) Then
 With ورقة1
.Cells(T, i).Value = ""
'.Rows(T).delete Shift:=xlUp
.Range(Cells(T, 1), Cells(T, 4)).delete Shift:=xlUp
Call delete

End With
    End If
    Next
    Next
    MsgBox "    لقد تم حذف الموظف من قاعدة البيانات   ", vbInformation, "إنهاء الحذف"

End If

للعلم كود

Call delete

Sub delete()
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For V = 1 To Lastrow - 1
Cells(V + 1, 1) = V
Next
End Sub

[الجموعي]

ياريت شرح لهذه الجزئية من الكود الرئيسي

عسى تفيدني في التعديل على الكود الرئيسي

For i = 1 To 1
For T = 1 To Lastrow

[ياسر خليل أبو البراء]

جرب التالي

تعديل على زر حذف.rar

[ibn_egypt]

أخى الفاضل أ.الجموعي

 

الأستاذ القدير أ.ياسر عدل لك كل ما تريد ولكنك بإزاحة الصفين لابد ان تعيد النظر في كل الكود البرمجي المكتوب وتعدل كافة النطاقات وخاصة في حدث تغير مربع النص الذي تكتب به كلمة البحث ، فبعد إذن ابن بلدي الغالي أ.ياسر، مرفق الملف بتعديل كافة النطاقات بعد إزاحة الصفين

 

تحياتي  

تعديل على زر حذف.rar

[الجموعي]

جرب التالي

أستاذي القدير بارك الله فيك

أنا جربت هذا الكود من قبل

لكن  مشكل في الترقيم أنا أريده يبدأ من الصف الثالث والترقيم يبدا برقم 1

مش 3

[الجموعي]

أستاذي الفاضل /إبن مصر

تعبتك معي في التعديل المفروض مهمتي انا

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

نفس المشكل راجع ما كتبته في المشاركة 9

[ibn_egypt]

أخى الفاضل الجموعي

 

لعل الملف المرفق هو المطلوب

 

تحياتي  

تعديل على زر حذف.rar

[الجموعي]

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

الواضح أني لم أوصل لك الفكرة جيدا

شاهد الصور ستفهم ما اقصده

أريد الترقيم يبقى كما قبل الحذف

 

 

 

 

 

 

 

وما الهدف من إضافة هذه الجزئية في حدث  زر الترحيل

 For i = 1 To 1
        For T = 4 To row_number
            If TextBox5.Text = ورقة1.Cells(T, 1) Then
        With ورقة1
            .Cells(T, i).Value = ""
            .Range(Cells(T, 1), Cells(T, 6)).delete Shift:=xlUp
            Call delete
        End With
        End If
        Next
        Next
    
        row_no = Range("A65536").End(xlUp).Row
        r = 4
        For X = 1 To row_no - 3
        With ورقة1
        .Cells(r, 1).Value = X
        r = r + 1
        End With
        Next

[الجموعي]

تم عمل المطلوب وهذا بفضل الأستاذ الفاضل /إبن مصر

جزاه الله كل الخير

قمت بوضع هذه الجزءية في حدث زر حذف وتمت العملية بنجاح

row_no = Range("A65536").End(xlUp).Row
        r = 4
        For X = 1 To row_no - 3
        With ورقة1
        .Cells(r, 1).Value = X
        r = r + 1
        End With
        Next

[ibn_egypt]

 

تم عمل المطلوب وهذا بفضل الأستاذ الفاضل /إبن مصر

جزاه الله كل الخير

قمت بوضع هذه الجزءية في حدث زر حذف وتمت العملية بنجاح

 

 

أخى الفاضل الجموعي

 

الحمد لله ان تحقق هدفك، وضعتها في الترحيل حتى يتم اعادة الترقيم بعد الترحيل مع ان المفترض وضعها في الحذف وسيعاد الترقيم سواء في الحذف او الترحيل  

 

تخاريف اخر الاسبوع،ههههههه

 

تحياتى  

[الجموعي]

 

 

تم عمل المطلوب وهذا بفضل الأستاذ الفاضل /إبن مصر

جزاه الله كل الخير

قمت بوضع هذه الجزءية في حدث زر حذف وتمت العملية بنجاح

 

 

أخى الفاضل الجموعي

 

الحمد لله ان تحقق هدفك، وضعتها في الترحيل حتى يتم اعادة الترقيم بعد الترحيل مع ان المفترض وضعها في الحذف وسيعاد الترقيم سواء في الحذف او الترحيل  

 

تخاريف اخر الاسبوع،ههههههه

 

تحياتى  

 

غلبتك معي لهيك معدتش مركز وكمان عامل النعاس

بارك الله فيك أستاذي القدير

إلى مشكلة أخرى غدا هههههههههه

لا تخاف بهزر معاك هههههههه