الزباري

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

بصراحة انت تحفة.. ربنا يديم نعمه عليك. أنا استخدمت الكود التالي لترحيل محتوى الفاتورة فقط: 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

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

يعني انك عامل عرض للأجيال القادمة.. تجربة رائعة جداً.. أهنيك عليها. الكود الذي تعاملتَ به كالتالي: 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 المهمة التالية:بعد إذن أستاذي أبوحنين.. إذا أمكن عمل الترحيل بزر منفصل وعدم دمجها في الفاتورة جديدة.. وذلك بسبب التطرق إلى بعض الكودات اللي عاوز أتحداك بيها ولإعطاء الفاتورة نوع من الديناميكية المرنة..

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

استخدم الرمز ^ الموجود فوق الرقم 6 ، فمثلاً 2 أس 3 تكتب كالتالي: =2^3

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

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

كيفية معرفة كود اللون: لمعرفة لون خلفية الخلية نتبع التالي: 1- نقف على الخلية لمعرفة لونها. 2- من قائمة الألوان اختر أوان إضافية. 3- ستجد رقم اللون بنظام الألوان RGB. وتقبلوا تحياتي

كود جميل لأيام الأسبوع بالعربي ومن روائع أبوحنين 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.rar

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

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

On Error GoTo ErrorHandler . . Cells(r, 1) = Cells(r - 1, 1) + 1 استكشاف الأخطاء وإصلاحها: هذا الكود يقوم بعملية الترقيم التلقائي، حيث يقوم بإضافة واحد على الخلية الحالية، بمعنى أن الخلية الحالية=الخلية السابقة+1 وهذه المعادلة تنطبق على جميع الخلايا فيما عدا الخلية الأولى، حيث تتكون الخلية الأولى على نص العنوان "م"، فبذلك لا يمكن جمع نص مع العدد واحد، وفي هذه الحالة أٌجبر الكود بأن يعتبرها أول رقم من الترقيم (يعني واحد).. ويتم توجيهها إلى الكود التالي: ErrorHandler: Cells(r, 1) = 1 Resume Next وتقبلوا تحياتي.. ترقبوا السؤال التالي.

تعقيب على ما سبق: استوقفتنا بعض الأمور من أخي أبو حنين. Qn As String في هذا الكود يتوجب على Qn أن تكون Integer بل الأصح أن تكون Byte حيث أن الكمية لا تتعدى 255. =========================================================== Qn = InputBox("أدخل الكمية", "الكمية") If Not IsNumeric(Qn) Then Exit Sub معنى الكود أنه إذا لم تكن الكمية رقم فسيتم انهاء الدالة (جرب إدخال نص) ولنزيد الكود جمالاً نضيف تحذير بأنه لم يتم إدخال رقم قبل الخروج من الدالة. =============================================

المرفق: فاتورة ديناميكية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- جعل الكمية الإفتراضية = 1 2- إضافة عبارة "شكراً لتسوقكم" مع تضليلها. 3- تضليل سطر وترك سطر في الفاتورة باللون الرمادي وتقبل تحياتي

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

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

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

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

الفورم التاسع: المرفق: http://www.excel-easy.com/vba/examples/excel-files/multicolumn-combo-box.xls الفورم العاشر: المرفق: http://www.excel-easy.com/vba/examples/excel-files/dependent-combo-boxes.xls الفورم الحادي عشر: المرفق: http://www.excel-easy.com/vba/examples/excel-files/loop-through-controls.xls وتقبلوا تحياتي

الفورم السادس: المرفق: http://www.excel-easy.com/vba/examples/excel-files/currency-converter.xls الفورم السابع: المرفق: http://www.excel-easy.com/vba/examples/excel-files/progress-indicator.xls الفورم الثامن: المرفق: http://www.excel-easy.com/vba/examples/excel-files/multiple-list-box-selections.xls

الفورم الخامس: المرفق: http://www.excel-easy.com/vba/examples/excel-files/userform-ranges.xls