mohamadhaje قام بنشر ديسمبر 24, 2024 قام بنشر ديسمبر 24, 2024 ارجو مساعدتي بانشاء زر ترحيل وانشاء فاتورة جديدة وحساب تلقائي للقيم الاجمالية لايتاثر بالترحيل ولم جزيل الشكر حساب.xlsm
mohamadhaje قام بنشر ديسمبر 27, 2024 الكاتب قام بنشر ديسمبر 27, 2024 ارجو مساعدتي بانشاء زر ترحيل وانشاء فاتورة جديدة وحساب تلقائي للقيم الاجمالية لايتاثر بالترحيل ولم جزيل الشكر بقيت عندي مشكلة حساب الاجمالي في الفاتورة ولايتأثر بالترحيل والكود الذي استخدمه هو 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
mohamadhaje قام بنشر ديسمبر 29, 2024 الكاتب قام بنشر ديسمبر 29, 2024 ارجو مساعدتي بانشاء زر ترحيل وانشاء فاتورة جديدة وحساب تلقائي للقيم الاجمالية لايتاثر بالترحيل ولم جزيل الشكر بقيت عندي مشكلة حساب الاجمالي في الفاتورة ولايتأثر بالترحيل والكود الذي استخدمه هو 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
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان