mohamed322 قام بنشر نوفمبر 17, 2020 مشاركة قام بنشر نوفمبر 17, 2020 السلام عليكم كنت محتاج أضيف فى حالة تكرار كود الموظف يقولى الموظف مكرر وشكراااا فورم ادخال الموظفيين جديد.xlsm رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 17, 2020 مشاركة قام بنشر نوفمبر 17, 2020 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 2 رابط هذا التعليق شارك More sharing options...
mohamed322 قام بنشر نوفمبر 17, 2020 الكاتب مشاركة قام بنشر نوفمبر 17, 2020 اولا شكرااا انا قصدى لو دخلت فى خانة كود الموظف مثل كود الموظف 1000 وبعد كدة دخلت فى كود الموظف 1000 يبلغنى أنة مكرر رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 17, 2020 مشاركة قام بنشر نوفمبر 17, 2020 الكود من أجل هذا الشيء 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 3 رابط هذا التعليق شارك More sharing options...
mohamed322 قام بنشر نوفمبر 17, 2020 الكاتب مشاركة قام بنشر نوفمبر 17, 2020 شكرااااااااا جداااااااااااا بارك الله فيكم رابط هذا التعليق شارك More sharing options...
عبدالفتاح في بي اكسيل قام بنشر نوفمبر 17, 2020 مشاركة قام بنشر نوفمبر 17, 2020 اخ محمد بخصوص هذ الخطا لديك زر تحكم لهم نفس الاسم عليك تغييره 2 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 استبدل ما موجود بالمربع الأحمر بالكود الذي رفعته لك 1 رابط هذا التعليق شارك More sharing options...
mohamed322 قام بنشر نوفمبر 18, 2020 الكاتب مشاركة قام بنشر نوفمبر 18, 2020 أنا أسف ممكن حضرتك تعدلة ليا على الأكسل دة علشان أنا لسة مبتدأ فورم ادخال الموظفيين جديد.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر نوفمبر 18, 2020 أفضل إجابة مشاركة قام بنشر نوفمبر 18, 2020 تفضل يا صديقي مجرد ان تدخل كود موجود مسبقاُ (من خلال الزر اضافة موظف) تحصل على رسالة خطأ moh_Unique_Code.xlsm 1 1 رابط هذا التعليق شارك More sharing options...
mohamed322 قام بنشر نوفمبر 22, 2020 الكاتب مشاركة قام بنشر نوفمبر 22, 2020 برجاء المساعدة فى زر لحفظ البيانات بعد الأضافة أو المسح او التعديل رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان