اذهب الي المحتوي
أوفيسنا

طلب مساعدة في تعديل الكود

Badr Al-Din MiLz

بواسطه Badr Al-Din MiLz
في منتدى الاكسيل Excel

 مشاركة
إذهب إلى أفضل إجابة Solved by محمد هشام.,

الردود الموصى بها

Badr Al-Din MiLz

Badr Al-Din MiLz

قام بنشر
قام بنشر

السلام عليكم 

عند الضغط على اضافة ترحيل اليانت على ورقة العمل شيت يروح ماحي : كود المنتج - سعر الشراء / سعر البيع وعدم الإنتقال الى السطر التالي وهذا هو الكود 

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

رابط هذا التعليق
شارك
عبدالفتاح في بي اكسيل

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

قام بنشر
قام بنشر

مجرد  تخمين  بناء  على  كلامك ..احدف  هذه  الاسطر  في  نهاية الكود  

Me.txt_product.Value = ""
Me.txt_price_sale.Value = ""
Me.txt_price_pru.Value = ""

 

  • Like 2
رابط هذا التعليق
شارك
Badr Al-Din MiLz

Badr Al-Din MiLz

قام بنشر
  • الكاتب
قام بنشر

سلام 

لا يا أخ لا أتجاهل اجابتك لأنني الكود لايعمل وأنا منهمك في كشف العيب فيه أعذرني إن نسيت ولكن لا تسئ الفهم على العموم لم أتلقى أي حل لحد الآن في حل هذه المعضلة.وتقبل اعتذاري،بالتوفيق 

 

رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر

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

أخي ممكن تشرح لي بالنسبة لكود المنتج هل تدخله يدويا ؟

أما بالنسبة للباقي لا تأخذ هم إن شاء الله سوف يتم إصلاح كل شيئ وزيادة ..... 

 

  • Like 1
رابط هذا التعليق
شارك
Badr Al-Din MiLz

Badr Al-Din MiLz

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم، ..تحية طيبة أما بالنسبة لكود المنتج يتم آليا عند كتابة 

المنتج / سعر الشراء / البيع / التنفيذ يكون آليا  ..بوركت أخي وأشكر لك سعيك

 

رابط هذا التعليق
شارك
  • أفضل إجابة
محمد هشام.

محمد هشام.

قام بنشر
  • أفضل إجابة
قام بنشر

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

 بالنسبة للكود يمكنك جعله بهده الطريقة اخي الكريم

وسبب تاخيري عن الرد على طلبك  هو  انني كنت انتظر جوابك بخصوص كود المنتج لاكن للاسف جوابك غير مفهوم  (كود المنتج يكتب آليا ) تتضمن عدة امور 

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

  • Like 3
رابط هذا التعليق
شارك
Badr Al-Din MiLz

Badr Al-Din MiLz

قام بنشر
  • الكاتب
قام بنشر

 ..How are you..Good evening
تحية طيبة أخي الفاضل

ألف ألف شكر على الإجتهاد والمتابعة وكان لك في ردك حلا لما هو مطلوب عندي وزيادة لك مني أزكى سلام

دمت وفيا ناصحا أمين يا أخي العزير

best wishes ..Thanks to you and your valuable help ..The code is 100% working
 

رابط هذا التعليق
شارك
زائر
هذا الموضوع مغلق.
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept