شوقي ربيع

شكرا جزيلا اخي ابا اسمعيل لعباراتك الجميلة لاضافة سطر جديد تلقائيا فقط اضف هذا الكود If IDRw = RwDt Then Call AddCont في الكلاس موديل المسمى ClsFct اخر الكود Private Sub MesComboBox_Change() فيصبح الكود على الشكل Private Sub MesComboBox_Change() If Len(MesComboBox.Name) = 8 Then RwDt = Left(MesComboBox.Name, 1) If Len(MesComboBox.Name) = 9 Then RwDt = Left(MesComboBox.Name, 2) If Len(MesComboBox.Name) = 10 Then RwDt = Left(MesComboBox.Name, 3) Call Shrch(MesComboBox.Text, MesComboBox.Name) Call SumTotal If IDRw = RwDt Then Call AddCont End Sub تحياتي لك

شكرا جزيلا اخي ابوسليمان على مرورك الطيب وعبراتك الجميلة تحياتي لك

ملاحظة يوجد اختصارين لاضافة اسطر في اليست و للحذف Alt+A لاضافة سطر جديد Alt+D لحذف السطر المفعل كما ان قوائم الاصناف تعمل بخاصية النص التنبئ و لعرض كافة الاسناف فقط احذف ما بداخل الكمبو بوكس وستضهر جميع الاصناف تحياتي للجميع

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

شكرا جزيلا لمرورك العطر اخي الزياري تحياتي لك

شكرا لمرورك العطر اخي طلعت كما ذكرة الموضوع محتاج الى اكثر من شرح تحياتي لك

شكرا جزيلا على عباراتك الجميلة اخي ابراهيم الموضوع يحتاج الى اكثر من شرح لانه يعتمد على عدت اساليب وكل جزء محتاج لدروس خاصة انما طرحة الموضوع لتكون هناك فكرة للاعضاء عن التقنيات المتقدمة في برمجة vba تحياتي لك

الله يسلمك اخي صلاح تحياتي لشخصكم الجميل

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

بسم الله الرحمان الرحيم السلام عليكم اعلم اعلم ان غيابي طال عنكم احبتي في الله هي الظروف ومشاغل الحياة التي تمنعني عنكم لاكن دائما و ابدا لن اعود بعد غيابي و انا فارغ اليدين لا اطيل عليكم اقدم لكم اليوم نموذج فاتورة بسيط مصمم على الاكسل ؟؟؟؟ ماذا يوجد الكثير من النماذج في المنتدى نعم يوجد لا كن هذا النموذج مختلف جدا عما الفتوموه من الاخر فكرة النموذج هي انشاء ليست برمجيا تسهل علينا ادخال الاصناف بالاضافة الا الشكل الجمالي لها ماذا ستستفيد من هذا البرنامج غير استعماله ؟؟ وانا اقصد الذين يريدون تطوير مهاراتهم في برمجة VBA اولا ستتعلم كيفية استخدام المصفوفات ثانيا ستتعلم شيئ اسمه الوراثة في البرمجة ثالث كيفية الاستفادة من الكلاس موديل و استخدامه مع الوراثة ملاحظة لم اعمل الجزء المتعلق باضافة و تعديل الاصناف وايضا الجزء المتعلق بالعملاء امرهم بسيط يمكن لاي عضو اضافة العملية من نفسه لا اطيل عليكم واترككم لتجربة البرنامج وانا طوع اي احد يريد الاستفسار حول اكواد البرنامج تحياتي للجميع FcteurRabie.rar

السلام عليكم شخصيا استخدم نسخة أوفيس فرنسية ولا تحوي اصلا RightToLeft في خصائص الفورم لذى استخدم الكود Me.RightToLeft = True لاكن يجب استخدامه دائما أول امر يقوم به الفورم عند الاقلاع او بالاحرى قبل تعبئة اليست بوكس نحن نعلم ان الحدث Initialize هو اول حدث يبدأ التنفيذ عند تشغيل الفورم حتى انه يبدأ تنفيذ الأكواد التي به قبل ضهور الفورم لاكن للاسف لا يمكن ان نضع الكود الخاص بمجاذات الفورم هنا في هذه الحالة الكود نفذ بالفعل اقصد كود المحاذات للاسف vba امكانياته محدودة لان سرعة تنفيذ الاكواد في حدث Initialize تخلي اليست بكوس( لاتشعر) ان صح التعبر بان الكود نفذ و تبقى مجمدة على طبيعتها الاولى لاكن لو كان عندنا ملتبيج مثلا في الفورم وكانت اليست في احد باجاته لو تغير الباجة وتعود الى الاولى ستلاحظ ان اليست تحولت الى اليمين المهم لتفادي ماسبق ذكره اعتبر ان وضع الكود بداية حدث Activate هو افضل طريقة مع مراعات عدم تعبئة اليست قبل تنفيذ كود المحاذات تحياتي

من خصائص اليوزر فورم ابحث عن RightToLeft و اجعلها True او استبدل الكود السابق بهذا Private Sub UserForm_Activate() Me.RightToLeft = True With Me.ListBox1 .ColumnCount = 4 .List = Range("D5:G14").Value End With End Sub

السلام عليكم في حدث اقلاع اليوزر فورم او زر امر او ماكرو اختر اولا عدد اعمدة اليست ثم حدد نطاق الجدول الذي تريده Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnCount = 4 .List = Range("D5:G14").Value End With End Sub تحياتي

السلام عليكم حسب فهي لطلبك هو انك لا تريد تكرار الاصناف في الفاتورة و هناك طريقتين لتنفيذ المطلوب الاولى باستخدام الطريقة التقليدية رسالة تنبيه و كود يمنع المستخدم من تكرار الصنف الثانية هي ما ساقدمه لك ببساطة الافكرة تعتمد على مصفوفتين الاولى تحمل جميع الاصناف المخزنة في الداتا و الثانية من اجل تصفية وحذف الاصناف التي استعملت بالفعل ثم نقوم باعادت تحميل البيانات المفلترة من المصفوفة الثانية الى المصفوفة الاولى ؟؟؟؟ قد تقول لما ذا هته الفة لماذا لا تفلتر في المصفوفة الاولى في حد ذاتها جوابي ببساطة شخصيا لا اعرف طريقة لحذف عنصر معين من المصفوة الذي اعرفه هو مسح المسفوفة بالكامل وان كان هناك من الاعضاء المحترمين في المنتدى يعلمون الطريقة فياريت يعلمني بالطريقة نعود الى موضوعنا اولا عرف مصفوفتين ول يكن تعريفهما على عامت الفورم وليس على حدث او SUB ما Dim Arr1(), Arr2() ثانيا نحتاج الى كود يملئ لنا المصفوفة الاولى من قاعدة البيانات وفي نفس الوقت يملئ قوائم الاصناف في الفورم Sub Listcmd() Dim ws As Worksheet Dim Lrw As Long Set ws = ThisWorkbook.Sheets("setup") Lrw = ws.Range("A" & Rows.Count).End(xlUp).Row Arr1 = Application.Transpose(ws.Range("B2:B" & Lrw).Value) For i = 8 To 13 Me("ComboBox" & i).List = Arr1 Next End Sub اما هذا الكود Sub ListArr(cmd As String) Dim sTe As String: sTe = Me(cmd).Text Dim ii As Long, e As Long: e = 0 For ii = LBound(Arr1) To UBound(Arr1) If CStr(Arr1(ii)) <> sTe Then e = e + 1: ReDim Preserve Arr2(e) Arr2(e) = Arr1(ii) End If Next ii ReDim Arr1(e): Arr1 = Arr2 End Sub يقوم بمسح الصنف الذي ياخذه المتغير cmd من المصفوفة اخيرا كود به حلقة تكرارية تدور حول كل الكمبوبوكس الخاصة بالاصناف لـاخذ القيمة التي تحملها وتذهب بها الى الكود السابق لكي يحذف الصنف من القائمة الاصناف ثم يعيد تعبئة الكمبوبوكس بالاصناف الغير مستعملة فقط Sub FList() Listcmd For i = 8 To 13 If Me("ComboBox" & i) <> "" Then ListArr Me("ComboBox" & i).Name Next For i = 8 To 13 Me("ComboBox" & i).List = Arr1 Next End Sub ملاحضة الكود يقوم بارجاع الصنف المحذوف في حالة تغيره يعني لو استعملت الصنف سيحذف من القوائم لاكن لو غيرت الصنف الى صنف اخر سيحذف الصنف الجديد من القائمة ويستبدل مكانه الصنف السابق له ارجو ان اكون قد وفق ولو قليل في شرح الفكرة وان يكون فيها افادة للجميع تحياتي للجميع فاتورة مبيعات.rar

السلام عليكم اخي ياسر خليل الف مبروك والى المزيد من النجاحات ان شاء الله تحياتي

السلام عليكم رويدكم ايها الاخوة هي دنيا فانية و لا تستحق لحظة غضبا واحدة كثر الكلام عن الحماية وضعف الاكسل في الحماية وماشابه ذلك نعم صحيح لو كانت كل الملفات محمية لما وصل لنا العلم الذي تعلمناه من بعضنا البعض في منتدى الاخوة هذا لاكن للحماية اسباب وكل واحد وأسبابه وشخصيا لا احبذ التكلم نيابة عن اي شخصا لذي ما اقوله هو رئي الشخصية هناك بعض البيانات التي يجب ان تحمى قلت بيانات وليست اكواد فلا يهمني حماية الاكواد مهما كانت قوية ومهما كان متعوب فيها خوفا من ان يستعملها غيري لانه حسب رئي الشخصي ان يستعمل احدا ما اكواد من برمجتي الخاصة فلي اجر استعمالها عند الله بأذن الله وذلك ان كان بعلمي او بدونه او برضاي او بعدمه فسبحان الذي لا يخفى عنه شيء أما ما قصدته بابيانات الشخصية في أول حديثي فهناك بعض البرمحيات تحتاج ان تردج بياناتك الشخصية في الاكواد كمثال الاكواد التي تتعامل مع البريد الالكتروني او التي تتعامل مع النت بصفة عامة فاغلبها يحتاج الى ان تضع اليوزرات و الباسورد الخاصة بك لكي تشتغل وهنا يجب عليا الحماية بل الحماية القصوة لانه لسنا نتعامل مع ملائكة و هناك ضعاف النفوس و كسر الحماية هنا يكون تعدي على البيانات الشخصية وهذا غير مقبول وفي الاخير اقول لا تستهينو بالاكسل و VBA كما يوجد طرق عديدة لكسر الحماية يوجد طرق اقوى للحماية تحايتي للجميع

الكود الذي برمجته لك في الرابط http://www.officena.net/ib/index.php?showtopic=53794 المشاركة رقم 16 يفي بالغرض

السلام عليكم الملف الذي ادرجته لا يحوي اي اكواد لذى لن يحدث لك اي شئ

السلام عليكم اشكرك اخي الكرم عن سؤالك عني وبارك الله فيك الضغط مرتين داخل الكمبوبوكس يضهر جميع البيانات المخزنة في الداتا لانه اثناء البحث القائمة تفلتر وهكذا ستغيب البيانات الاخرى لذى عمنا في حدث الضغط المزدوج ارجاع كل البيانات اما البحث حسب عمود اخر فقط غير في السطر If UCase(Ary(i, 2)) Like d Then هذا مثال للبحث بدلالة العمود الثاني تحياتي

يجب ان تكون الادات مثبة في الجهاز الذي ستنقل له الملف بل سيعطي خطاء لعدم وجود الاداة ملاحظة ممكن تبرمج ملف دفعي تدرجه مع الملف يقوم بتثبت الادات عند فتح الملف اول مرة سأحاول برمجة الملف و ارفقه مع الموضوع

للاسف لا يمكن ذلك فهذه الادات تعمل على كلمل الملف يعني الشيت الاكسل واليوزر فورم وحتى محرر الاكواد هته الاداة مصممة اصلا ل VB6 وليس لل VBA انما قمنا بتركيبها على الاكسل

السلام عليكم جزيتم خيرا وبارك الله فيكم على عباراتكم الطيفة

فرضا اننا سنرحل البيانات التي في العمود A و العمود B ابتدأ من السطر 4 الى الاعمدة D و E ابتدأ من السطر 4 ايضا يكون الكود كالتالي Sub TEST() Dim ObjCell As Range Dim n: n = 4 For Each ObjCell In Range("A4:A" & Cells(Rows.Count, "B").End(xlUp).Row).Cells Range("D" & n).Resize(3, 2).Value = ObjCell.Resize(1, 2).Value n = n + 3 Next: End Sub

السلام عليكم ما رئيك ان اقول لك ان الامر ابسط مما تظن اليط هته المعادلة التي صممتها لهذا الغرض Function rabie(x As Double, xx As Double, xxx As Double) As String On Error Resume Next If x = x * xxx Then rabie = "علاقة حاصل ضرب" ElseIf x = x * xxx Then rabie = "علاقة طرح" ElseIf x = x * xxx Then rabie = "علاقة جمع" ElseIf x = x * xxx Then rabie = "علاقة قسمة" Else rabie = "لايوجد علاقة" End If End Function الصيغة العامة لدالة rabie(قيمة البحث عن العلاقة;القيمة الاولى;القيمة الثانية) البحث عن علاقة رقم بمجموعة ارقام اخرى.rar

الكود يكون كالاتي Sub TEST() Dim x(): x = Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value Dim n: n = 4 Dim i As Integer: For i = 1 To UBound(x) Range("G" & n).Resize(6, 1).Value = x(i, 1) n = n + 6 Next: End Sub او Sub TEST2() Dim ObjCell As Range Dim n: n = 4 For Each ObjCell In Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells Range("G" & n).Resize(6, 1).Value = ObjCell.Value n = n + 6 Next: End Sub حيث n = 4 هي بداية الصف الذي ترحل اليه البيانات