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

[الزباري]

3 ساعات مضت, جلال الجمال_ابو أدهم said:

الزباري

أبو حنــــين

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

 

يسعدنا تواجدك معنا يا أبو أدهم..

بس شفت عرض أبوحنين (اشتر واحدة وباقي الكمية مجاناً).. يا بلاش.

تحياتي للجميع

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

1 ساعه مضت, الزباري said:

يسعدنا تواجدك معنا يا أبو أدهم..

بس شفت عرض أبوحنين (اشتر واحدة وباقي الكمية مجاناً).. يا بلاش.

تحياتي للجميع

أبو حنــــين

حبيبنا يرد انا مش هقول حاجه
جزاكم الله خيرا 
تحياتى

 

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

السلام عليكم جميعا

 

3 ساعات مضت, الزباري said:

بس شفت عرض أبوحنين (اشتر واحدة وباقي الكمية مجاناً).. يا بلاش.

عرض مغري و محدود من تاريخ 2100/01/01   الى    2199/12/31    و الكمية محدودة   و الرجاء من الزبائن عدم التدافع و احترام الطابور   . الكل حياخد نصيبو . 

******************************************

تم استدارك الخطأ و استرجاع الاموال الضائعة من المصيبة الى فاتت

مع بحث و تعديل فاتورة

ارجو التجربة لاستدراك الاخطاء

 

5-فاتورة.rar

[الزباري]

يعني انك عامل عرض للأجيال القادمة.. تجربة رائعة جداً.. أهنيك عليها.

الكود الذي تعاملتَ به كالتالي:

Last = Cells(Rows.Count, 1).End(xlUp).Row + 1
iNane = Target.Offset(, 1).Value

For R = 9 To Last
If CStr(Cells(R, 2).Value) = iNane Then
Cells(R, 2).Offset(, 1).Value = Cells(R, 2).Offset(, 1).Value + Val(Qn)
Cells(R, 2).Offset(, 3).Value = Cells(R, 2).Offset(, 1).Value * Cells(R, 2).Offset(, 2).Value
Cells(Last, 5).Value = WorksheetFunction.Sum(Range("E9:E" & Last - 1))
Exit Sub
End If
Next

معادلات سليمة ومجموع سليم وكله تمام التمام

 

أما أنا فقد استخدمت الكود التالي:

Range("a8").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(0, 1).Value = Target.Offset(0, 1).Value Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value + qty
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, 2).Value * ActiveCell.Offset(0, 3).Value
Cells(r, 5) = Cells(r, 5) + qty * ActiveCell.Offset(0, 3).Value
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
Loop

المرفق:

فاتورة ديناميكية3.rar

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

[A7med.7amdi]

جزاكم الله خيرا استفدنا منكم الكثير

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

مرحبا 

هذا كود حاص بالترحيل

Sub tarhil()

If Cells(9, 1).Value = "" Then Exit Sub
With Application
	.ScreenUpdating = False
	Range(Cells(9, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Copy _
	Sheet2.Range("F" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1)
	R1 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
	R2 = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
	Range("A5:E5").Copy Sheet2.Range("A" & R1 & ":E" & R2)
	.CutCopyMode = False: .ScreenUpdating = True
End With

End Sub

 

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

اخى الزبارى

اخى ابو حنين

ماشاء الله عليكو

اكواد ف غايه الروعه والجمال

.............

اخى الزبارى

ليش يا اخى ما اعتمدت على كود الصنف فى احضار بياناته

تسهيلا على المستخدم

يعنى اكتب مثلا a001 يكتب هو برتقال ويكتب السعر 100

اعتقد كده هيكون اسرع فى توفير الجدهد والوقت

تقبلو تحياتى

[الزباري]

أخي ابراهيم أبوليله..

حرصنا في هذا المثال بأن تكون هناك أفكار غير مألوفة للكود، وإلا ما قلته متداول بكثرة في هذا المنتدى،فالتعامل مع المرجع خاص بالقوائم الكبيرة مع استخدام جهاز الاسكنر، والقائمة التي لدينا صغيرة، ومن الصعوبة بمكان تذكر هذه المراجع في حال أن لديك أكثر من 100 صنف، تابعنا إلى النهاية حتى نقوم بتكبير القائمة ومن ثم سنلبي طلبك في الموضوع، حتى تتضح الرؤية ، فمش مهم تكون محترف vba ولكن مهم يكون عندك معلومات عن vba

تحياتي

تم تعديل نوفمبر 14, 2016 بواسطه الزباري

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

اخى الزبارى

متابعينك

للنهايه ان شاء الله

تقبل تحياتى

[الزباري]

17 ساعات مضت, أبو حنــــين said:

مرحبا 

هذا كود حاص بالترحيل

Sub tarhil()

If Cells(9, 1).Value = "" Then Exit Sub
With Application
	.ScreenUpdating = False
	Range(Cells(9, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Copy _
	Sheet2.Range("F" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1)
	R1 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
	R2 = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
	Range("A5:E5").Copy Sheet2.Range("A" & R1 & ":E" & R2)
	.CutCopyMode = False: .ScreenUpdating = True
End With

End Sub

 

بصراحة انت تحفة.. ربنا يديم نعمه عليك.

أنا استخدمت الكود التالي لترحيل محتوى الفاتورة فقط:

Dim i As Integer
i = 1
Do
i = i + 1
Loop Until Sheets("sheet2").Cells(i, 1).Value = ""

Sheets("sheet1").Range("a9").Select
Do Until ActiveCell.Value = ""
Sheets("sheet1").Range(ActiveCell, ActiveCell.End(xlToRight)).Copy Sheets("sheet2").Cells(i, 1)
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop

 

[A7med.7amdi]

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

تم تعديل نوفمبر 14, 2016 بواسطه A7med.7amdi

[الزباري]

وقبل أن أنتقل إلى المهمة التالية أطلب من سيادتكم بأن نقسم الترحيل إلى شيتين (ورقتين):

الأول كالتالي:

والثاني كالتالي:

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

[A7med.7amdi]

ياريت الرد علي طلبي لو امكن ذلك

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

18 دقائق مضت, A7med.7amdi said:

ياريت الرد علي طلبي لو امكن ذلك

لترحيل القيم فقط

Sub tarhil()

If Cells(9, 1).Value = "" Then Exit Sub
With Application
.ScreenUpdating = False
Range(Cells(9, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Copy
Sheet2.Range("F" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues
R1 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
R2 = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
Range("A5:E5").Copy
Sheet2.Range("A" & R1 & ":E" & R2).PasteSpecial xlPasteValues
.CutCopyMode = False: .ScreenUpdating = True
End With

End Sub

حيث استعملنا PasteSpecial xlPasteValues

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

منذ ساعه, الزباري said:

وقبل أن أنتقل إلى المهمة التالية أطلب من سيادتكم بأن نقسم الترحيل إلى شيتين (ورقتين):

الأول كالتالي:

والثاني كالتالي:

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

الكود يصبح بهذا الشكل

Sub tarhil()

If Cells(9, 1).Value = "" Then Exit Sub
With Application
.ScreenUpdating = False
Range(Cells(9, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Copy _
Sheet2.Range("A" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1)
'___________________________

Range("A5:E5").Copy Sheet3.Range("A" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row + 1)

Sheet3.Range("F" & Sheet3.Cells(Rows.Count, 5).End(xlUp).Row).Value = _
Range("E" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Value
.CutCopyMode = False: .ScreenUpdating = True
End With

End Sub

 

[الزباري]

وهذا ملف على عجل

فاتورة ديناميكية4.rar

 

 

أخي أبوحنين.. ياليت تزودنا بالملف

[A7med.7amdi]

1 hour ago, أبو حنــــين said:

لترحيل القيم فقط

Sub tarhil()

If Cells(9, 1).Value = "" Then Exit Sub
With Application
.ScreenUpdating = False
Range(Cells(9, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Copy
Sheet2.Range("F" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues
R1 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
R2 = Sheet2.Cells(Rows.Count, 6).End(xlUp).Row
Range("A5:E5").Copy
Sheet2.Range("A" & R1 & ":E" & R2).PasteSpecial xlPasteValues
.CutCopyMode = False: .ScreenUpdating = True
End With

End Sub

حيث استعملنا PasteSpecial xlPasteValues

جزاك الله خير اخى الكريم ونفعنا الله بعلمك

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

السلام عليكم

الملف بعد التعديل

 

فاتورة ديناميكية 5.rar

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

 

أبو حنــــين

الزباري

الاخوه الافاضل جزاكم الله خيرا
تحياتى

متابعين 

[الزباري]

ما نستغنى عنك يا أبوحنين

المهمة التالية:الآن حان وقت وضع بعض القيود.. عاوزين نضع القيود التالية:

1- يمنع إصدار فاتورة جديدة مالم يتم ترحيل الفاتورة.

2- يمنع إضافة صنف إلى الفاتورة بعد ترحيلها.

3- يمنع تكرار  الفاتورة.

 

 

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

[الزباري]

4- يمنع ترحيل فاتورة فارغة.

[عبدالله بشير عبدالله]

ما شاء الله ولا حول ولا قوة الا بالله

مشكورين على الجهوذ والدروس القيمة

أسال الله ان يحفظكما  بحفظه وان يجازيكما خيرا وان يزدكما علما

معكما الى النهاية

[الزباري]

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

اعذرونا على التأخير الشديد بسبب انشغالنا الشديد في الفترة الماضية.

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

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

في مثالنا هذا تم التعامل مع الخلية G1 كمرجع ، فعند الترحيل يتم إعطائها القيمة True وبذلك نضمن عدم تكرار الترحيل وكذلك إيقاف إضافة أصناف جديدة للفاتورة، وعند الضغط على زر فاتورة جديدة تتغير قيمة G1 إلى False ، ولا يمكن عمل فاتورة جديدة طالما أن الفاتورة فارغة.

[الزباري]

 

المرفق:

فاتورة ديناميكية 6.rar

[الزباري]

تبقى لنا مهمتين وننهي الدرس بإذن الله تعالى.. تابعونا