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

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

قام بنشر

السلام عليكم 

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

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

قام بنشر

سلام 

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

 

قام بنشر

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

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

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

 

  • Like 1
قام بنشر

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

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

 

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

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

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

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

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
قام بنشر

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

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

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

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

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

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

Important Information