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

[الزباري]

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

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

تم تجهيز فكرة لعمل فاتورة ديناميكية (بدون فورم)، وبها أفكار إبداعية متنوعةـ وحتى تتمازج الأفكار سأطرحها بطريقة متسلسلة أقف عند بعض الأكواد بانتظار مشاركة الخبراء، وسنعتمد الكود السهل والقصير أملاً أن تعم الفائدة للجميع.

ترقبونا

[الزباري]

للتشويق ستكون فاتورتنا كالتالي:

[إبراهيم ابوليله]

اخى الزبارى

ممكن تراجع الرابط الاتى

https://www.officena.net/ib/index.php?showtopic=55762&hl=

لعله يفيد فى الموضوع

تقبل تحياتى

[الزباري]

جزاك الله خيراً أ.ايراهيم وزادك الله حرصاً على كل ما هو جديد..

وكما تعودنا سنقوم ببناء الفااتورة من البداية حتى النهاية، وسنتطرق بها إلى كيفية إنشاء قاعدة بيانات بأسس علمية إلى الترحيل والإستدعاء والطباعة إلى حفظ ورقة العمل.. ونطلب منكم التفاعل وتزويدنا بما ترونه مناسباً.

 

بإذن الله سنتعامل مع هذا الملف المبدئي:

فاتورة.rarFetching info...

[الزباري]

 

السؤال الأول: ما هو الكود الذي يقوم بالعمليات التالية بعد الضغط مرتين على رقم المنتج ليجعله ينتقل إلى الفاتورة كالتالي:

[أبو حنــــين]

الإجابة عن السؤال الأول

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Last As Integer, Qn As String
If Target.Column = 8 And Target.Row > 3 And Target <> "" Then
Cancel = True
Last = Cells(Rows.Count, 1).End(xlUp).Row + 1
Qn = InputBox("أدخل الكمية", "الكمية")
If Not IsNumeric(Qn) Then Exit Sub
    With Cells(Last, 1)
    .Value = Last - 8: .Offset(, 1).Value = Target.Offset(, 1).Value
    .Offset(, 2).Value = Val(Qn): .Offset(, 3).Value = Target.Offset(, 2).Value
    .Offset(, 4).Value = Val(Qn) * Target.Offset(, 2).Value: .Offset(1, 3).Value = "ÇáÅÌãÇáí"
    .Offset(1, 4).Value = WorksheetFunction.Sum(Range("E9:E" & Last ))
    End With
    With Range(Cells(Last, 1), Cells(Last, 5))
    .Borders.Value = 1: .Borders.ColorIndex = 48
    End With
End If

End Sub

 

تم تعديل نوفمبر 9, 2016 بواسطه أبو حنــــين

[الزباري]

ما شاء الله عليك يا أستاذنا أبو حنين ، دائماً سباق، وطريقتك جميلة جداً، يا حبذا إرفاق المرفق حتى نتعامل معه إلى النهاية،

بقي لديك ثلاثة أمور وهي:

1- جعل الكمية الإفتراضية  = 1

2- إضافة عبارة "شكراً لتسوقكم" مع تضليلها.

3- تضليل سطر وترك سطر في الفاتورة باللون الرمادي

 

وتقبل تحياتي

 

[أبو حنــــين]

السلام عليكم

الملف بعد التعديل مع اضافة مسح للبيانات

 

فاتورة.rar

[الزباري]

بارك الله فيك .. أشكر تفاعلك البناء.. بقي تلوين سطر دون الآخر

 

وسنشرح بعض الأمور المتعلقة بالكود لاحقاً .. انتظرونا

[أبو حنــــين]

مرحبا

تم عمل المطلوب

 

1-فاتورة.rar

[الزباري]

عظمة على عظمة.. أستاذي أبوحنين.. ويكأنك بتقول لي ليه تبيع مويه في حارة السقايين.. تُشكر على هذا العمل الرائع.

أما بالنسبة لي فقد أنجزتها بالكود التالي:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h4:h25")) Is Nothing Then

r = 9
Sum = 0
Do While Cells(r, 1) <> ""
Sum = Sum + Cells(r, 5)
r = r + 1

Loop
On Error GoTo ErrorHandler
qty = InputBox(Prompt:=" ÃÏÎá ÇáßãíÉ ÇáÎÇÕÉ È " & Target.Offset(0, 1).Value, Title:="ÅÏÇÑÉ ÇáãÊÌÑ", Default:=1)
If Not IsNumeric(qty) Then Exit Sub
Cells(r, 1) = Cells(r - 1, 1) + 1
Cells(r, 2) = Target.Offset(0, 1).Value

Cells(r, 3) = qty
Cells(r, 4) = Target.Offset(0, 2).Value
Cells(r, 5) = Cells(r, 3) * Cells(r, 4)
End If
Cells(r - 1, 1).Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Borders.LineStyle = xlNone
Cells(r, 1).Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Borders(xlEdgeBottom).Weight = xlThin
Range(ActiveCell, ActiveCell.End(xlToRight)).Offset(2, 0).Interior.Color = xlNone
Cells(r + 1, 3).Font.Color = vbBlack
Cells(r + 1, 3) = ""

Cells(r + 1, 4) = "ÇáÅÌãÇáí"
Cells(r + 1, 5) = Sum + Cells(r, 5)
Range(ActiveCell, ActiveCell.End(xlToRight)).Offset(3, 0).Interior.Color = RGB(15, 36, 62)
Cells(r + 3, 3) = "ÔßÑÇð áÊÓæÞßã"
Cells(r + 3, 3).Font.Color = vbWhite
shadding
Exit Sub

ErrorHandler:
Cells(r, 1) = 1
Resume Next

End Sub

Sub shadding()
Dim i As Integer
i = 10
Do
i = i + 1
Loop Until Cells(i, 1).Value = ""
i = i - 1

If Cells(10, 1).Value = "" Then
Exit Sub
Else

Dim Col As Long
  Dim Row As Long
  For Col = 1 To 5
    For Row = 10 To i Step 2
      Sheet1.Cells(Row, Col).Interior.Color = RGB(200, 200, 200)
    Next Row
  Next Col
  
End If
End Sub

 

[الزباري]

 

 

المرفق:

فاتورة ديناميكية1.rarFetching info...

[الزباري]

تعقيب على ما سبق:

استوقفتنا بعض الأمور من أخي أبو حنين.

Qn As String

في هذا الكود يتوجب على Qn أن تكون Integer بل الأصح أن تكون Byte حيث أن الكمية لا تتعدى 255.

===========================================================

 

Qn = InputBox("أدخل الكمية", "الكمية")
If Not IsNumeric(Qn) Then Exit Sub

معنى الكود أنه إذا لم تكن الكمية رقم فسيتم انهاء الدالة (جرب إدخال نص)

ولنزيد الكود جمالاً نضيف تحذير بأنه لم يتم إدخال رقم قبل الخروج من الدالة.

=============================================

[الزباري]

On Error GoTo ErrorHandler
.
.
Cells(r, 1) = Cells(r - 1, 1) + 1

استكشاف الأخطاء وإصلاحها: هذا الكود يقوم بعملية الترقيم التلقائي، حيث يقوم بإضافة واحد على الخلية الحالية، بمعنى أن الخلية الحالية=الخلية السابقة+1

وهذه المعادلة تنطبق على جميع الخلايا فيما عدا الخلية الأولى، حيث تتكون الخلية الأولى على نص العنوان "م"، فبذلك لا يمكن جمع نص مع العدد واحد، وفي هذه الحالة أٌجبر الكود بأن يعتبرها أول رقم من الترقيم (يعني واحد).. ويتم توجيهها إلى الكود التالي:

ErrorHandler:
Cells(r, 1) = 1
Resume Next

 

 

وتقبلوا تحياتي.. ترقبوا السؤال التالي.

[أبو حنــــين]

 السلام عليكم

أخي الزباري جزاكم الله خيرا

في انتظار السؤال الموالي . . . .

[الزباري]

السؤال التالي:

إضافة زر يقوم بحذف بيانات الفاتورة وإضافة فاتورة جديدة.. وقد سبقنا بها أبوحنين في الجزئية الأولى.

فما هو الكود الذي يحقق ما سبق كالتالي:

 

[أبو حنــــين]

السلام عليكم

تم عمل المطلوب مع إضافة خاصية حفظ الفاتورة الحالية تحسبا لاستدعائها او تعديلها

ربما الملف يحتوي على اخطاء لانني جربته لمرتين او ثلاث مرات فقط 

ان كانت هناك اخطاء سنستدركها حالة اكتشافها

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

 

2-فاتورة.rar

[الزباري]

يا خطيييير

لكن يا حبذا جعل طريقة الدفع الإفتراضية هي نقداً حتى لا تكون مصدر إزعاج للبائع.. فيكفي تغيير رقم الفاتورة.

وثانياً: نريد أن تكون أيام الأسبوع بالعربي.. ابحث عن الكود البديل.

تحياتي

[أبو حنــــين]

السلام عليكم

تم  عمل المطلوب ان شاء الله

و تبقى التجربة هي السبيل الوحيد لاكتشاف الاخطاء

 

3-فاتورة.rar

[الزباري]

كود جميل لأيام الأسبوع بالعربي ومن روائع أبوحنين

Nmb = Weekday(Range("C5").Value)
Art = Array("الاحد", "الاثنين", "الثلاثاء", "الاربعاء", "الخميس", "الجمعة", "السبت")
For i = LBound(Art) To UBound(Art)
If Nmb = i + 1 Then Range("B5").Value = Art(i)
Next

وهذا كود آخر مختصر

Cells(5, 2) = Choose(Weekday([today()]), "الأحد", "الأثنين", "الثلاثاء", "الأربعاء", "الخميس", "الجمعه", "السبت")

 

المرفق:

فاتورة ديناميكية2.rarFetching info...

[الزباري]

كيفية معرفة كود اللون:

لمعرفة لون خلفية الخلية نتبع التالي:

1- نقف على الخلية لمعرفة لونها.

2- من قائمة الألوان اختر أوان إضافية.

3- ستجد رقم اللون بنظام الألوان RGB.

 

وتقبلوا تحياتي

[الزباري]

المهمة التالية:

نضيف كود يجعلنا نمنع تكرار الصنف في الفاتورة، بل نزيد في الكمية.. بمعنى أننا إذا أضفنا صنف موجود في الفاتورة فإنه لا يدرجه في سطر جديد، بل يبحث عن هذا الصنف ويزيد كميته.

وتقبلو تحياتي

[أبو حنــــين]

السلام عليكم

تم عمل المطلوب

4-فاتورة.rar

[الزباري]

جمييييل بارك الله فيك.. لكن الإجمالي لم يتغير ، وبعدين راح تخسر في المبيعات ، واللي ببلاش كثر منه.

[جلال الجمال_ابو أدهم]

الزباري

أبو حنــــين

جزاكم الله خيرا 
موضوع شيق و اثنين محترمين
تحياتى