JavaScript is not enabled!...Please enable javascript in your browser

جافا سكريبت غير ممكن! ... الرجاء تفعيل الجافا سكريبت في متصفحك.

-->
الصفحة الرئيسية

فاتورة مبيعات احترافية فى الاكسل خطوة خطوة من الصفر للاحتراف Invoice In excel

 بسم الله الرحمن الرحيم 

اهلا بكم متابعى موقع عالم الاوفيس

كيفية فاتورة مبيعات احترافية فى الاكسل خطوة خطوة من الصفر للاحتراف

سوف نتاناول اليوم كيفية عمل فاتورة مبيعات excel, وتصميم فاتورة مبيعات خطوة خطوة للمبتدئين فى الاكسل,وكيفية  عمل فاتورة مبيعات من الصفر الى الاحتراف

سوف نقسم اجزاء شرح اكواد الفاتورة الى 5 اكواد مهمة 



  1. كود حفظ البيانات 

وفى هذا الكود يتم ترحيل البيانات من شيت الفاتورة   Invoice الى شيت Invoice Data 

   

 Sub save_Click()

 

  Dim rng As Range

  Dim temp As Variant

  Dim i As Long

  Dim a As Long

  Dim rng_dest As Range

  Application.ScreenUpdating = False

  i = 1

   Set rng_dest = Sheets("Invoice data").Range("D:G")

 

  '(

Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0

  i = i + 1

    Loop

  '

  Set rng = Sheets("Invoice").Range("B10:E25")

  

  For a = 1 To rng.Rows.Count

  If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then

    rng_dest.Rows(i).Value = rng.Rows(a).Value

       '

  Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("e2").Value

        

       Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("c6").Value

       

      Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("c7").Value

       i = i + 1

    End If

    Next a

  MsgBox "Invioce Saved", 64

 

  Sheets("Invoice").Range("e2").Value = Sheets("Invoice data").Range("h1").Value

      

Sheets("Invoice").Range("B10:E25").ClearContents

 Sheets("Invoice").Range("c7:e7").ClearContents

    Application.ScreenUpdating = True

 

End Sub

 

 

 

 

الكود الثانى

  • كود البحث عن الفاتورة 

فى هذا الكود نقوم بالبحث عن رقم الفاتورة واحضارها الى شيت الفاتورة INvoice حتى يتم طباعتها وا التعديل عليها 

   

 Sub search()

Dim RowStart As Long

Dim RowEnd As Long

 

'ايجاد الصفوف الخاصة بالفاتورة

Dim x As String

x = InputBox("ادخل رقم الفاتورة", "رسالة")

RowStart = Sheets("Invoice data").Columns("A").Find(x, _

  SearchOrder:=xlRows, LookAt:=xlWhole, SearchDirection:=xlNext, _

  LookIn:=xlValues).Row

 

RowEnd = Sheets("Invoice data").Columns("A").Find(x, _

  SearchOrder:=xlRows, LookAt:=xlWhole, SearchDirection:=xlPrevious, _

  LookIn:=xlValues).Row + 1

 

'مسح الخلايا فى شيت الفاتورة

Sheets("Invoice").Range("B10:E25").ClearContents

 

'تحميل بيانات الفاتورة

 

Sheets("Invoice").Range("B10").Resize(RowEnd - RowStart, 4).Value = _

Sheets("Invoice data").Range("D" & RowStart & ":G" & RowEnd).Value

 

Sheets("Invoice").Range("c6").Value = Sheets("Invoice data").Range("B" _

& RowStart).Value

Sheets("Invoice").Range("e2").Value = Sheets("Invoice data").Range("A" _

& RowStart)

Sheets("Invoice").Range("c7").Value = Sheets("Invoice data").Range("C" _

& RowStart)

 

End Sub

 

 

 

 



الكود الثالث 

  • كود تعديل الفاتورة 

بعد ان تم البحث عن الفاتورة برقم الفاتورة واحضارها الى شيت الفاتورة Invoice حيث تم التعديل عليها 

ونريد حفظ التعديل 

يتم من خلال الكود التالى 

  

 Sub Edit_Click()

  Dim rng As Range

  Dim i As Long

  Dim a As Long

  Dim rng_dest As Range

  Application.ScreenUpdating = False

 

  i = 1

 

  Do Until Sheets("Invoice data").Range("A" & i).Value = ""

    If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("e2").Value Then

 

      If MsgBox("Overwrite invoice data?", vbYesNo) = vbNo Then

     

        Exit Sub

       

      Else

       

        Exit Do


      End If   

    End If

    i = i + 1

  Loop

  i = 1

 

  Set rng_dest = Sheets("Invoice data").Range("D:G")

 

  'فى حالة وجود رقم الفاتورة هيحذف الصفوف الخاصة بالفاتورة

 

  Do Until Sheets("Invoice data").Range("A" & i).Value = ""

 

    If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("e2").Value Then

   

      Sheets("Invoice data").Range("A" & i).EntireRow.Delete

     

      i = 1

     

    End If

   

    i = i + 1

   

  Loop

 

 

 

  ' هيدور على اخر صف فية بيانات فى شيت الترحيل

 

  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0

 

    i = i + 1

 

  Loop

 

  'هينسخ المدى بتاع الفاتورة

 

  Set rng = Sheets("Invoice").Range("B10:E25")

 

  ' ترحيل الصفوف التى تحتوى على بيانات فى الفاتورة

 

 For a = 1 To rng.Rows.Count

 

    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then

 

      rng_dest.Rows(i).Value = rng.Rows(a).Value

 

      'ترحيل البيانات الفردية

      'ترحيل رقم الفاتورة

 

      Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("e2").Value

 

      'ترحيل التاريخ

 

      Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("c6").Value

 

      'اسم العميل

 

      Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("c7").Value

 

      i = i + 1

 

    End If

 

  Next a

  Sheets("Invoice").Range("c7:e7").ClearContents

 

Sheets("Invoice").Range("b10:e25").ClearContents

 

  MsgBox ("Invoice saved!")

Worksheets("Invoice data").Range("a1").Select

    ActiveWorkbook.Worksheets("Invoice data").Sort.SortFields.Add Key:=Range("A1" _

        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 

 

  Application.ScreenUpdating = True

 

End Sub

 

 

 

الكود الرابع 

  • كود فاتورة جديدة 

وفى هذا الكود نقوم بعمل مسح للبيانات القديمة الموجود فى الفاتورة واستبدالها بالبيانات الجديدة وايضا عمل رقم جديد للفاتورة

   

Sub new_invoice()

 

'

   Sheets("Invoice").Range("e2").Value = Sheets("Invoice data").Range("h1").Value

      'مسح الخلايا فى شيت الفاتورة

Sheets("Invoice").Range("B10:E25").ClearContents

  Sheets("Invoice").Range("c7:e7").ClearContents

 

End Sub

 

الكود الخامس 

  • كود طباعة الفاتورة 

وفى هذا الكود يتم طباعة الفاتورة بالكامل 

 Sub print_invoice()

Range("a1:f27").PrintPreview

End Sub  

 


لتحميل ملف العمل من هنا

الاسمبريد إلكترونيرسالة