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

[الـعيدروس]

السلام عليكم

الاخوة والاساتذه الكرام

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

اّلية الكود يحذف صف الاسم في ورقة 1

اريد الكود يبحث عن الاسم في ورقة 2 ويحذفه

بمعنى ان وجد في ورقة 2 يقوم بحذفه مع الاسم الموجود في ورقة 1

وارجو عمل توضيح بسيط على الكود

كي نتعلم الاليه اذا امكن

هذا هو الكود

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim DADA As String

Dim MYSH As Worksheet

Dim PASSWORD As Integer

On Error Resume Next

PASSWORD = InputBox("الرجاء ادخال الرقم المصرح لك به لاتمام العمليه", "إدخال تصريح لحذف موظف مع جميع بياناته")

If PASSWORD <> "1234" Then

MsgBox "تم الغاء الامر"

Else

If MsgBox(":لقد طلبت حذف البيانات التالية" & vbNewLine & "" & vbNewLine & "إسـم المـوظف:  " & TextBox3 _

& vbNewLine & "" & vbNewLine & "رقم الحساب:  " & TextBox2 & vbNewLine & "" & vbNewLine & "" _

& vbNewLine & "فهل تود الإستمرار؟", vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then

A = Application.WorksheetFunction.Match(ListBox1, RNG1, 0)

Application.ScreenUpdating = False

MsgBox " تم حذف السجل الخاص ب" & ListBox1 & " بنجاح", vbInformation, "تم الحذف"

Application.ScreenUpdating = False

DADA = ListBox1.List(ListBox1.ListIndex, 8)

Set MYSH = Sheets("فترة صباحية")

With MYSH

.Application.Range(DADA).Rows.Select

.Range(DADA).EntireRow.Delete

Application.ScreenUpdating = True

End With

End If

End If

ListBox1.Clear

TextBox4.Text = ""

TextBox4.SetFocus

End Sub

والسلام عليكم

حذف_اسم.rar

[بن علية حاجي]

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

أخي الكريم هذه محاولة في تغيير الكود وإن شاء الله يكون هذا المطلوب.... وأرفق لك الملف بالكود الذي تم تغييره (في حالة ما لم تظهر الكلمات المكتوبة بالعربية)...

 

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 

Dim DADA As String 

Dim MYSH1 As Worksheet 

Dim MYSH2 As Worksheet 

Dim PASSWORD As Integer 

On Error Resume Next 

PASSWORD = InputBox("الرجاء ادخال الرقم المصرح لك به لاتمام العمليه", "إدخال تصريح لحذف موظف مع جميع بياناته") 

If PASSWORD <> "1234" Then 

MsgBox "تم الغاء الامر" 

Else 

If MsgBox(":لقد طلبت حذف البيانات التالية" & vbNewLine & "" & vbNewLine & "إسـم المـوظف:  " & TextBox3 _ 

& vbNewLine & "" & vbNewLine & "رقم الحساب:  " & TextBox2 & vbNewLine & "" & vbNewLine & "" _ 

& vbNewLine & "فهل تود الإستمرار؟", vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then 

A = Application.WorksheetFunction.Match(ListBox1, RNG1, 0) 

Application.ScreenUpdating = False 

MsgBox " تم حذف السجل الخاص ب" & ListBox1 & " بنجاح", vbInformation, "تم الحذف" 

Application.ScreenUpdating = False 

DADA = ListBox1.List(ListBox1.ListIndex, 8) 


Set MYSH1 = Sheets("فترة صباحية") 

With MYSH1 

.Application.Range(DADA).Rows.Select 

.Range(DADA).EntireRow.Delete 

Application.ScreenUpdating = True 

End With 


Set MYSH2 = Sheets("فترة مسائية") 

With MYSH2 

.Application.Range(DADA).Rows.Select 

.Range(DADA).EntireRow.Delete 

Application.ScreenUpdating = True 

End With


End If 

End If 

ListBox1.Clear 

TextBox4.Text = "" 

TextBox4.SetFocus

End Sub

أخوك بن علية

حذف_اسم.rar

تم تعديل سبتمبر 4, 2011 بواسطه hben

[الـعيدروس]

السلام عليكم

جزاك الله خير استاذ بن عليه

ماكنت اتوقع انه بالسهوله ذي

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

[عبدالله المجرب]

الاستاذ بن عليه

مبدع كالعادة

تعمل بصمت ، حلولك ذات جودة

بارك الله لك في ما رزقك من العلم وسدد على الخير خطاك

ابواحمد

[الـعيدروس]

السلام عليكم

الاستاذ الفاضل بن عليه

بعد كم تجربه صار الفورم لايحذف من الورقة 2

ارجو التعديل على الكود