Badr Al-Din MiLz قام بنشر سبتمبر 30, 2022 قام بنشر سبتمبر 30, 2022 السلام عليكم عند الضغط على اضافة ترحيل اليانت على ورقة العمل شيت يروح ماحي : كود المنتج - سعر الشراء / سعر البيع وعدم الإنتقال الى السطر التالي وهذا هو الكود Private Sub CommandButton10_Click() If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If Dim lr As Integer lr = appliction.worksheetfuncion.CountA(sh.Range("A:A")) sh.Range("A" & lr + 1).Value = lr sh.Range("B" & lr + 1).Value = Me.txt_product.Value sh.Range("C" & lr + 1).Value = Me.txt_price_sale.Value sh.Range("D" & lr + 1).Value = Me.txt_price_pru.Value Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = "" MsgBox "لقد تم إضافة المنتج بنجاح", vbtnformation End Sub المحل.xlsm
عبدالفتاح في بي اكسيل قام بنشر أكتوبر 1, 2022 قام بنشر أكتوبر 1, 2022 مجرد تخمين بناء على كلامك ..احدف هذه الاسطر في نهاية الكود Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = "" 2
عبدالفتاح في بي اكسيل قام بنشر أكتوبر 1, 2022 قام بنشر أكتوبر 1, 2022 حسنا تتجاهل اجابتي لم تقل اذا كانت تعمل معك ام لا . انتظر المساعدة من شخص اخر . 2
Badr Al-Din MiLz قام بنشر أكتوبر 1, 2022 الكاتب قام بنشر أكتوبر 1, 2022 سلام لا يا أخ لا أتجاهل اجابتك لأنني الكود لايعمل وأنا منهمك في كشف العيب فيه أعذرني إن نسيت ولكن لا تسئ الفهم على العموم لم أتلقى أي حل لحد الآن في حل هذه المعضلة.وتقبل اعتذاري،بالتوفيق
محمد هشام. قام بنشر أكتوبر 1, 2022 قام بنشر أكتوبر 1, 2022 السلام عليكم ورحمة الله وبركاته أخي ممكن تشرح لي بالنسبة لكود المنتج هل تدخله يدويا ؟ أما بالنسبة للباقي لا تأخذ هم إن شاء الله سوف يتم إصلاح كل شيئ وزيادة ..... 1
Badr Al-Din MiLz قام بنشر أكتوبر 2, 2022 الكاتب قام بنشر أكتوبر 2, 2022 السلام عليكم، ..تحية طيبة أما بالنسبة لكود المنتج يتم آليا عند كتابة المنتج / سعر الشراء / البيع / التنفيذ يكون آليا ..بوركت أخي وأشكر لك سعيك
محمد هشام. قام بنشر أكتوبر 2, 2022 قام بنشر أكتوبر 2, 2022 السؤال هل هناك رقم او رمز معين لكود المنتج او ترقيم تلقائي 1.2.3 إلى آخره 1
Badr Al-Din MiLz قام بنشر أكتوبر 3, 2022 الكاتب قام بنشر أكتوبر 3, 2022 سلام ، لا يا أخي يكتب كود المنتج آليا تحياتي ..
أفضل إجابة محمد هشام. قام بنشر أكتوبر 3, 2022 أفضل إجابة قام بنشر أكتوبر 3, 2022 السلام عليكم ورحمة الله تعالى وبركاته بالنسبة للكود يمكنك جعله بهده الطريقة اخي الكريم وسبب تاخيري عن الرد على طلبك هو انني كنت انتظر جوابك بخصوص كود المنتج لاكن للاسف جوابك غير مفهوم (كود المنتج يكتب آليا ) تتضمن عدة امور Private Sub CommandButton10_Click() If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("b:b"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If With ActiveSheet If .FilterMode Then .ShowAllData lr = .Cells(Rows.Count, 1).End(3).Row + 1 Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru) End With Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = "" MsgBox "Done", vbtnformation End Sub اما الزيادة التي سبق ان وعدتك بها في المشاركة السابقة هي عبارة عن ملفك يتضمن جميع الاظافات التي من الممكن ان تحتاجها . ترحيل _ تعديل _ حدف _ بحث بكود المنتج Private Sub CommandButton9_Click() '''''''''ترحيل البيانات''''''''' ''الشرط الاول'' If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If ''الشرط الثاني'' If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If ''الشرط الثالث'' If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If ''التحقق من وجود اسم المنتج مسبقا '' Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If ''''''''''' النطاق المرحل اليه'''''''''''' Dim lr As Long lr = Sheets("product_master").Range("B" & Rows.Count).End(xlUp).Row With sh .Cells(lr + 1, "b").Value = Me.txt_product.Value .Cells(lr + 1, "c").Value = Me.txt_price_pru.Value .Cells(lr + 1, "d").Value = Me.txt_price_sale.Value End With ''''''''افراغ textbox''''''' Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" ''''''''(A)ترقيم تلقائي لعمود '''''' ''مع امكانية حدف الصفوف '' Worksheets("product_master").Activate Application.EnableEvents = False With Range("a2:a" & Cells.Find("*", , , , xlByRows, xlPrevious).Row) .Formula = "=Row() - 1" .Value = .Value End With Application.EnableEvents = True MsgBox "تم الترحيل بنجاح", vbtnformation '' UserForm_تحديث '' Unload Me frm_product_master.Show End Sub '''''''''' البحث بكود المنتج'''''''''''' Private Sub CommandButton10_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then txt_product = Sheets("product_master").Cells(y, 2).Value txt_price_pru = Sheets("product_master").Cells(y, 3).Value txt_price_sale = Sheets("product_master").Cells(y, 4).Value End If Next y End Sub ''''''''''''''''تعديل البيانات'''''''''''''''' Private Sub CommandButton12_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Sheets("product_master").Cells(y, 2).Value = txt_product Sheets("product_master").Cells(y, 3).Value = txt_price_pru Sheets("product_master").Cells(y, 4).Value = txt_price_sale End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم التعديل بنجاح", vbInformation End Sub ''''''''''''''''حدف صف معين'''''''''''''''' Private Sub CommandButton13_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Rows(y).Delete End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم حدف البيانات بنجاح", vbInformation Call MH Unload Me frm_product_master.Show End Sub ''''''''''''''''UserForm _ تحديث واجهة '''''''''''''''' Sub Refresh_data() Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") Dim lr As Long lr = Sheets("product_master").Range("a" & Rows.Count).End(xlUp).Row If lr = 1 Then lr = 2 With Me.ListBox .ColumnCount = 4 .ColumnHeads = True .RowSource = "product_master!A2:d" & lr End With End Sub Private Sub CommandButton14_Click() If MsgBox("هل تريد الخروج من البرنامج", vbQuestion + vbYesNo, "Confirmation") = vbYes Then Unload Me End If End Sub Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean) txtSearch.Text = ListBox.Column(0) If txtSearch.Text = Me.ListBox.Column(0) Then Me.txt_product = Me.ListBox.Column(1) Me.txt_price_pru = Me.ListBox.Column(2) Me.txt_price_sale = Me.ListBox.Column(3) End If End Sub المحل_MH.xlsm 3
Badr Al-Din MiLz قام بنشر أكتوبر 5, 2022 الكاتب قام بنشر أكتوبر 5, 2022 ..How are you..Good evening تحية طيبة أخي الفاضل ألف ألف شكر على الإجتهاد والمتابعة وكان لك في ردك حلا لما هو مطلوب عندي وزيادة لك مني أزكى سلام دمت وفيا ناصحا أمين يا أخي العزير best wishes ..Thanks to you and your valuable help ..The code is 100% working
هانى محمد قام بنشر أكتوبر 5, 2022 قام بنشر أكتوبر 5, 2022 Badr Al-Din MiLz فين انت من ده كله .. أين الضغط على الإعجاب 💙 ؟!!!! 1
الردود الموصى بها