عدم تكرار كود الموظف

[mohamed322]

السلام عليكم

كنت محتاج أضيف فى حالة تكرار كود الموظف يقولى الموظف مكرر

وشكراااا 

فورم ادخال الموظفيين جديد.xlsm

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

1-لا حاجة لنكرار المتغيرات في كل كود من أكواد اليوزر يكفي ان تعلنها مرة واحدة في البداية

2- تم التعديل على الأكواد (الغاء الحلقات التكرارية التي ترهق البرنامج في حال كانت البيانات كثيرة)
      والاستيعاض عنها بدالة Find التي تضع يدها على الصف المناسب رأساً بدون التفتيش في كل الصفوف
3- ما الحاجة الى ادخال 1000 صف في ال ـ TextBox     النطاق   A2:E1000  من خلال Form Initialize ونحن بحاجة الى القليل منها  (البيانات حتى اخر صف غير فارغ)

4- الاكواد بعد التعديل

Option Explicit
Dim RO%, t%
Dim My_sh As Worksheet
Dim Sarch_rg As Range
Dim Found_rg As Range
'++++++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub CommandButton1_Click() 'add Employ

Set My_sh = Sheets("sheet1")
 RO = ws.Cells(Rows.Count, 1).End(3).Row + 1

With My_sh.Cells(RO, 1)
 .Value = Me.txtcode.Value
 .Offset(, 1) = Me.txtname.Value
 .Offset(, 2) = Me.txtjop.Value
 .Offset(, 3) = Me.txtadress.Value
 .Offset(, 4) = Me.txtid.Value
End With
Me.ListBox1.RowSource = "a2:e" & RO
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton2_Click() 'search
Set My_sh = Sheets("sheet1")
RO = My_sh.Cells(Rows.Count, 1).End(3).Row
Set Sarch_rg = My_sh.Range("A1:A" & RO)
Set Found_rg = Sarch_rg.Find(txtcode.Text, lookat:=1)
 If Found_rg Is Nothing Then
  MsgBox "Not Fount"
  Exit Sub
 Else
  t = Found_rg.Row
  With My_sh.Cells(t, 1)
   Me.txtcode.Text = .Value
   Me.txtname.Text = .Offset(, 1)
   Me.txtjop.Text = .Offset(, 2)
   Me.txtadress.Text = .Offset(, 3)
   Me.txtid.Text = .Offset(, 3)
  End With
 End If
   
End Sub
'+++++++++++++++++++++++++++++++++++++

Private Sub CommandButton3_Click() 'Remove

Set My_sh = Sheets("sheet1")
RO = My_sh.Cells(Rows.Count, 1).End(3).Row
Set Sarch_rg = My_sh.Range("A1:A" & RO)
Set Found_rg = Sarch_rg.Find(txtcode.Text, lookat:=1)
 If Found_rg Is Nothing Then
  MsgBox "Not Fount"
  Exit Sub
  Else
 t = Found_rg.Row
  My_sh.Cells(t, 1).Resize(, 5).Delete
 End If
  
End Sub
'++++++++++++++++++++++++++++++++++++++
Private Sub CommandButton4_Click()
Dim txt
 For Each txt In Frame2.Controls
  If TypeOf txt Is msforms.TextBox Then
    txt.Text = ""
  End If
 Next txt
End Sub
'+++++++++++++++++++++++++++++++++
Private Sub CommandButton5_Click()
Set My_sh = Sheets("sheet1")
Application.Dialogs(xlDialogPrinterSetup).Show
 My_sh.PrintOut copies:=1

End Sub
'+++++++++++++++++++++++++++++++++++
Private Sub CommandButton6_Click()
Unload Me
End Sub
'++++++++++++++++++++++++++++++++
Private Sub CommandButton7_Click() 'Update

Set My_sh = Sheets("sheet1")
RO = Cells(Rows.Count, 1).End(xlUp).Row
Set Sarch_rg = My_sh.Range("A1:A" & RO)
Set Found_rg = Sarch_rg.Find(txtcode.Text, lookat:=1)
 If Found_rg Is Nothing Then
  MsgBox "Not Fount"
  Exit Sub
 Else
t = Found_rg.Row
        With My_sh.Cells(t, 1)
        .Offset(, 1) = Me.txtname.Text
        .Offset(, 2) = Me.txtjop.Text
        .Offset(, 3) = Me.txtadress.Text
        .Offset(, 4) = Me.txtid.Text
        End With
        Me.ListBox1.RowSource = "a2:e" & RO
        MsgBox "Data Edite Succesufly", vbInformation, "alarm"
       
    End If
 End Sub
 '+++++++++++++++++++++++++++++++++++++++++++++
Private Sub UserForm_Initialize()
Set My_sh = Sheets("sheet1")
RO = My_sh.Cells(Rows.Count, 1).End(3).Row
Me.ListBox1.ColumnCount = 5
Me.ListBox1.RowSource = "a2:e" & RO
End Sub

الملف مرفق

moh_Form_322.xlsm

[mohamed322]

اولا شكرااا

انا قصدى لو دخلت فى خانة  كود الموظف 

مثل كود الموظف 1000

وبعد كدة دخلت فى كود الموظف 1000 يبلغنى أنة مكرر

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

الكود من أجل هذا الشيء

Private Sub CommandButton1_Click() 'add Employ

 Set My_sh = Sheets("sheet1")
 RO = My_sh.Cells(Rows.Count, 1).End(3).Row + 1

Set Sarch_rg = My_sh.Range("A1:A" & RO)
Set Found_rg = Sarch_rg.Find(txtcode.Text, lookat:=1)
 If Not Found_rg Is Nothing Then
  MsgBox "This Code is allready Exists" & Chr(10) & _
  "In thee cell: " & Found_rg.Address(0, 0), 64
  Exit Sub
 Else
With My_sh.Cells(RO, 1)
 .Value = Me.txtcode.Value
 .Offset(, 1) = Me.txtname.Value
 .Offset(, 2) = Me.txtjop.Value
 .Offset(, 3) = Me.txtadress.Value
 .Offset(, 4) = Me.txtid.Value
End With
End If
Me.ListBox1.RowSource = "a2:e" & RO
End Sub

 

[mohamed322]

شكرااااااااا جداااااااااااا بارك الله فيكم

 

[عبدالفتاح في بي اكسيل]

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

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

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

 

[mohamed322]

أنا أسف ممكن حضرتك تعدلة ليا على الأكسل دة علشان أنا لسة مبتدأ

فورم ادخال الموظفيين جديد.xlsm

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

تفضل يا صديقي

مجرد ان تدخل كود موجود مسبقاُ (من خلال الزر اضافة موظف) تحصل على رسالة خطأ

moh_Unique_Code.xlsm

[mohamed322]

برجاء المساعدة فى زر لحفظ البيانات بعد الأضافة أو المسح او التعديل