انشاء زر ترحيل وانشاء فاتورة جديدة

[mohamadhaje]

ارجو مساعدتي بانشاء زر  ترحيل وانشاء فاتورة جديدة وحساب تلقائي للقيم الاجمالية لايتاثر بالترحيل ولم جزيل الشكر 

حساب.xlsm

[mohamadhaje]

ارجو مساعدتي بانشاء زر  ترحيل وانشاء فاتورة جديدة وحساب تلقائي للقيم الاجمالية لايتاثر بالترحيل ولم جزيل الشكر 

بقيت عندي مشكلة حساب الاجمالي في الفاتورة ولايتأثر بالترحيل والكود الذي استخدمه هو

 

Sub ترحيل_البيانات()
    Dim wsInvoice As Worksheet
    Dim wsSales As Worksheet
    Dim nextRow As Long
    Dim i As Integer
    
    ' تحديد الأوراق
    Set wsInvoice = ThisWorkbook.Sheets("فاتورة مبيعات")
    Set wsSales = ThisWorkbook.Sheets("مبيعات")
    
    ' إيجاد الصف التالي في ورقة "مبيعات"
    nextRow = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).row + 1
    
    ' رقم الفاتورة التلقائي
    If IsEmpty(wsInvoice.Range("B2").Value) Then
        wsInvoice.Range("B2").Value = Application.WorksheetFunction.Max(wsSales.Columns("A")) + 1
    End If

    ' حساب الإجمالي في الفاتورة (E8:E23)
    For i = 8 To 23
        If wsInvoice.Cells(i, "C").Value <> "" And wsInvoice.Cells(i, "D").Value <> "" Then
            wsInvoice.Cells(i, "E").Value = wsInvoice.Cells(i, "C").Value * wsInvoice.Cells(i, "D").Value
        Else
            wsInvoice.Cells(i, "E").Value = "" ' إذا لم تكن الكمية أو السعر مدخلة، تكون الخلية فارغة
        End If
    Next i
    
    ' ترحيل البيانات العامة
    wsSales.Cells(nextRow, "A").Value = wsInvoice.Range("B2").Value ' رقم الفاتورة
    wsSales.Cells(nextRow, "B").Value = Date ' تاريخ اليوم
    wsSales.Cells(nextRow, "K").Value = wsInvoice.Range("B4").Value ' الصندوق
    wsSales.Cells(nextRow, "M").Value = wsInvoice.Range("F4").Value ' طريقة الدفع
    wsSales.Cells(nextRow, "H").Value = wsInvoice.Range("F5").Value ' المدفوع
    wsSales.Cells(nextRow, "L").Value = wsInvoice.Range("D4").Value ' المستودع
    wsSales.Cells(nextRow, "C").Value = wsInvoice.Range("D2").Value ' اسم العميل

    ' ترحيل التفاصيل (نوع المادة، الكمية، السعر، الإجمالي، البيان)
    For i = 8 To 30
        If wsInvoice.Cells(i, "B").Value <> "" Then ' التحقق من وجود بيانات
            wsSales.Cells(nextRow, "D").Value = wsInvoice.Cells(i, "B").Value ' نوع المادة
            wsSales.Cells(nextRow, "E").Value = wsInvoice.Cells(i, "C").Value ' الكمية
            wsSales.Cells(nextRow, "F").Value = wsInvoice.Cells(i, "D").Value ' السعر
            wsSales.Cells(nextRow, "G").Value = wsInvoice.Cells(i, "E").Value ' الإجمالي
            wsSales.Cells(nextRow, "J").Value = wsInvoice.Cells(i, "F").Value ' البيان
            nextRow = nextRow + 1
        End If
    Next i
   يرجى التصحيح ولكم جزيل الشكر
    ' إعادة تعيين رقم الفاتورة للمرة القادمة
    wsInvoice.Range("B2").Value = Application.WorksheetFunction.Max(wsSales.Columns("A")) + 1

    ' مسح البيانات من ورقة "فاتورة مبيعات"
    wsInvoice.Range("B4").ClearContents ' الصندوق
    wsInvoice.Range("F4").ClearContents ' طريقة الدفع
    wsInvoice.Range("F5").ClearContents ' المدفوع
    wsInvoice.Range("D4").ClearContents ' المستودع
    wsInvoice.Range("D2").ClearContents ' اسم العميل
    wsInvoice.Range("B8:F30").ClearContents ' التفاصيل: نوع المادة، الكمية، السعر، الإجمالي، البيان

    MsgBox "تم ترحيل البيانات بنجاح وتم تفريغ الفاتورة!", vbInformation
End Sub

حساب.xlsm