الصـقر

الطريقه الحاديه عشر :- تعبئه الكمبوبوكس بأستخدام المصفوفه ويتم ترتيبها ابجديا اولا ثم تعبئة الكمبوبوكس هذه الطريقه للاستاذ القدير / ياسر خليل تفضل بها علينا وارسلها لى على الخاص الكود مشروح جاهز Private Sub UserForm_Initialize() 'يوضع الكود في حدث الفورم ويقوم بعمل قائمة كومبوبوكس مميزة في عناصرها ومرتبة أبجدياً 'تعريف المتغيرات Dim A, E 'مسح محتويات الكومبوبوكس ComboBox2.Clear '[Sheet1] بدء التعامل مع ورقة العمل المسماة برمجياً With Sheet1 'ليحمل قيم النطاق في العمود الثاني أي أنها تعتبر مصفوفة بكل القيم في هذا النطاق [A] تعيين قيمة للمتغير A = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).value End With 'بدء التعامل مع المصفوفات With CreateObject("System.Collections.ArrayList") '[Aِ] من عناصر المصفوفة [E] عمل حلقة تكرارية لكل عنصر For Each E In A 'إذا كان العنصر لا يساوي فراغ ولا يوجد عنصر مماثل في المصفوفة أي يتم التعامل مع القيم الفريدة If (E <> "") * (Not .Contains(CStr(E))) Then 'يتم إضافة العنصر إلى المصفوفة الجديدة التي تحتوي على قيم فريدة غير مكررة .Add CStr(E) End If Next 'ترتيب عناصر المصفوفة الجديدة تصاعديا .Sort 'إضافة عناصر المصفوفة الجديدة للكومبوبوكس ComboBox2.List = .ToArray End With End Sub لو حضرتك عايز الترتيب يكون من ( تنازليا ) فقط غير هذا السطر .Sort الى .Sort: .Reverse تقبلوا تحياتى

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

اخى الكريم نايف اعتقد على حد علمى والله اعلم ان هذا الشئ غير موجود اللى هو اضافه مسافه بادئه للنص لا يوجد من ضمن خصائص التكست فى شاشة التصميم خاصيه لهذا النوع ( الا اذا فى حد من الخبراء عنده رائ اخر ) ولكن يمكن عمل كود فى حدث تحديث التكست كالتالى بفرض ان التكست بوكس عندك رقمه 1 انسخ الكود التالى Private Sub TextBox1_AfterUpdate() TextBox1 = " " & TextBox1 & " " End Sub تقبل تحياتى

تمام يا كبير الكبير كبير من يومه مجرد ملحوظه يا غشاش انت بالكود مكنتش محتاج تعمل عدد 2 مجموعه مجموعه وحده تكفى لانك لست بحاجه الى التانيه Private Sub ComboBox1_Change() ComboBox2.Clear On Error Resume Next Dim data As Range Dim aseel As Collection Dim aseel2 As Collection Set aseel = New Collection Set aseel2 = New Collection For Each data In sheet1.Range("f2:f" & sheet1.Cells(Rows.Count, "f").End(xlUp).Row) If data.Offset(0, -1).Value = ComboBox1.Value Then aseel.Add data, data.Text aseel2.Add data.Offset(0, 1).Value, data.Text End If Next data With Me.ComboBox2 For i = 1 To aseel.Count .AddItem aseel(i) .List(.ListCount - 1, 1) = aseel2(i) Next i End With End Sub كان المفروض يكون كدا فقط Private Sub ComboBox1_Change() ComboBox2.Clear On Error Resume Next Dim data As Range Dim aseel As Collection Set aseel = New Collection For Each data In sheet1.Range("f2:f" & sheet1.Cells(Rows.Count, "f").End(xlUp).Row) If data.Offset(0, -1).Value = ComboBox1.Value Then aseel.Add data, data.Text End If Next data With Me.ComboBox2 For i = 1 To aseel.Count .AddItem aseel(i) Next i End With End Sub تقبل تحياتى واحترامى لشخصك الكريم وشاكر لك اهتمامك بالموضوع

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

كله موجود فى نفس الملف يا معلم الصوره

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

اتفضل يا غالى روابط المشاركات الخاصه بذالك الطريقه السابعه فى الرابط التالى http://www.officena.net/ib/topic/64037-سلسلة-علمنى-كيف-اصطاد-الفورم-forms/?do=findComment&comment=418716 والطريقه الثامنه فى الرابط التالى http://www.officena.net/ib/topic/64037-سلسلة-علمنى-كيف-اصطاد-الفورم-forms/?do=findComment&comment=419207 والطريقه التاسعه فى الرابط التالى http://www.officena.net/ib/topic/64037-سلسلة-علمنى-كيف-اصطاد-الفورم-forms/?do=findComment&comment=419382

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

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

الطريقه العاشره :- تعبئه الكمبوبوكس بأستخدام Set هذه هى الطريقه الاخيره من طرق الكمبوبوكس وعلشان هى الاخيره والاعمال بالخواتيم اللهم ارزقنا جميعا حسن الخاتمه فطريقه اليوم طريقه سهله جدا وتتميز بالبساطه يعنى هنقزز كدا شوى مع بعض ونتسلى ( استراحه متعلم ) لو عندى شيت زى كدا وفيه بيانات وعايز اقوم بتعبئة الكمبوبوكس بالبيانات المظلله باللون الاخضر شاهد الصوره يوجد طريقتين الطريقه الاولى :- لو نطاق البيانات عندى ثابت كما هو بالجدول من A2: b5 هستخدم الكود التالى Dim R As Range Set R = Sheet1.Range("A2:b5") Me.ComboBox1.List = R.Cells.Value كود سهل جدا وبسيط السطر الاول الاعلان عن المتغيرر وقمت بتسميته R ( وممكن تسميه اى اسم كيفما شئت) وانه ان المتغير ده من النوع Range وعايز احول المتغير ده الى كائن بحيث اعرفه واقدر اتعامل معاه فأستخدمت set وهذه الكلمة هى لتحويل المتغير الى كائن القاعده الخاصه بـ Set هى الكائن = المتغير set ("Set R = Sheet1.Range("A2:b5 بعد ما عرفت الكائن وحددت نطاقه دلوقتى اقدر استخدمه واتعامل معه Me.ComboBox1.List = R.Cells.Value هذا السطر يعنى ان قائمة الكمبوبوكس تساوى النطاق قيمة كل خليه فى النطاق R الطريقه الثانيه :- لو نطاق البيانات عندى متغير كما هو بالجدول من A2: b5 ولكن يمكن اضافه اسماء جديده او حذف اسماء موجود فى هذه الحاله هو نفس الكود ولكن هيتم تعريف اخر صف به بيانات هستخدم الكود التالى Dim R As Range Set R = Sheet1.Range("A2:b" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row) Me.ComboBox1.List = R.Cells.Value وطبعا اتكلمنا قبل كدا ماذا يعنى سطر تعريف اخر خليه بها بيانات يبقى تحديد وقت تنفيذ الكود وزى ما اتفقنا قبل كدا ان وقت تنفيذ الكود انت اللى بتحدده ولكن على سبيل المثال فى حدث فتح الفورم Private Sub UserForm_Initialize() Dim R As Range Set R = Sheet1.Range("A2:b" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row) Me.ComboBox1.List = R.Cells.Value End Sub طبعا فى طرق اخرى ولكن لا ارى جدوى منها فنكتفى بعشر طرق تم تناولها لننتقل الى شروحات اخرى فأنا والله لم ابخل عليكم بمعلومه فكل ما يهمنى ويشغل بالى هو تبسيط المعلومه بعيدا عن الكلمات المعقده واكون دائما حريص على تنوعها ففى تعبئة الكمبوبوكس اتكلمت عن عشر طرق كان بالامكان اكتفى بطريقه او طريقتين ولكن الامانه العلمية وحبى لكم تقتضى على ان اعرفكم بكل شئ عايزكم تكونو احسن منى مش بس زى انا وما يحزننى هو احساسى بان الناس مش مهتمه بالموضوع لسبب او لاخر أحيانا الانسان لما بيزرع شجره بيكون عايز يشوف ثمرة جهده وعرقه فأنا مستمر فى غرس الشجر مهما كانت العواقب والعواصف أن شاء الله بعد الانتهاء من كل الشروحات هيتم تحويله الى كتيب الكترونى Pdf وان شاء الله يكون اول كتاب باللغه العربيه فى شروحات الفورم اللى بيدخل فى ادق التفاصيل واعمقها والى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد انتظرونا تقبلوا تحياتى

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

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

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

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

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

الطريقه التاسعه :- تعبئه الكمبوبوكس بدون تكرار وبناء على شرط باستخدام الحلقه التكراريه For Each و المتغير Collection وداله If (طريقه احترافيه) لو عندى شيت زى كدا وفيه بيانات وعايز اقوم بتعبئة الكمبوبوكس بالبيانات المظلله باللون الاخضر ولكن دون تكرار وبناء على اسم المعرض شاهد الصوره كما هو مبين بالصوره انا عايز اقوم بتعبئة الكمبوبوكس ولكن حسب عملاء معينه مثلا وليكن الجزائر ( عبدالعزيز البسكرى و شوقى ربيع ) فقط نعمل ايه؟ هو نفس الكود السابق اللى بالطريقه الثامنه مع تعديل بسيط تعالو نشوف الكود كان ايه ؟ وما هو التعديلات اللى هتم عليه ؟ Private Sub UserForm_Initialize() On Error Resume Next Dim data As Range Dim group1 As Collection Dim group2 As Collection Set group1 = New Collection Set group2 = New Collection For Each data In Sheet1.Range("A2:A" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row) group1.Add data, data.Text group2.Add data.Offset(0, 1).Value Next data With Me.ComboBox1 For i = 1 To group1.Count .AddItem group1(i) .List(.ListCount - 1, 1) = group2(i) Next i End With End Sub اللى هيتم تغييره بالكود 1- هذا السطر للحلقه For Each For Each data In Sheet1.Range("A2:A" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row) هنا بدل الحلقه ما بتلف على خلايا العمود A هخليها تلف على خلايا العمود B زى كدا For Each data In Sheet1.Range("b2:b" & Sheet1.Cells(Rows.Count, "b").End(xlUp).Row) 2- بعد سطر الحلقه التكراريه هعمل شرط لجلب البيانات وذالك من خلال قاعدة If انا عايز اجيب عملاء الجزائر فقط If data.Offset(0, -1).Value = "الجزائر" Then group1.Add data, data.Text group2.Add data.Offset(0, 1).Value, data.Text End If زى ما احنا شايفين سطر الكود استخدمنا If لعمل شرط ما هو الشرط ؟ الشرط ان data اللى بتمثل كل خلية فى العمود B يبص على الخليه اللى قبلها يعنى مثلا لما يكون data قيمتها B2 يبص على الخلية اللى قبلها اللى هى A2 ( طبعا دا تم من خلال offset ) طيب هو لما يبص على الخلية اللى قبلها A2 هيختبر ايه ؟ عايزه يشوف هل مكتوب بها الجزائر أو لا ؟ اذا كانت بها الجزائر ينفذذ الاسطر التالية ثم انهاء If وطبعا شرحنا معنى هذه الاسطر قبل كدا وبعد هذه التعديلات البسيطه على الكود هيكون شكله النهائى كدا فى حدث فتح الفورم Private Sub UserForm_Initialize() On Error Resume Next Dim data As Range Dim group1 As Collection Dim group2 As Collection Set group1 = New Collection Set group2 = New Collection For Each data In Sheet1.Range("b2:b" & Sheet1.Cells(Rows.Count, "b").End(xlUp).Row) If data.Offset(0, -1).Value = "الجزائر" Then group1.Add data, data.Text group2.Add data.Offset(0, 1).Value, data.Text End If Next data With Me.ComboBox1 For i = 1 To group1.Count .AddItem group1(i) .List(.ListCount - 1, 1) = group2(i) Next i End with End Sub شاهد الصوره عند فتح الفورم ************************************************************************************** واحد فنان هيسئلنى سؤال فنى ************************************************************************************** هو انا لو عايز مصر مثلا مش الجزائر لازم ادخل كل مره على الكود واغير فى هذا السطر If data.Offset(0, -1).Value = "الجزائر" Then هغير بدل من الجزائر اعملها مصر If data.Offset(0, -1).Value = "مصر" Then هقوله الاجابه ايوا لكن انا عارف قصدك انت عايز طريقه احترافيه وهى تعبئة الكمبوبوكس بناء على اخر فى الحاله دى لازم اعمل كمبوبوكس جديد فى الفورم اتبع معى الخطوات التالية الخطوه الاولى :- هنصمم كمبوبوكس جديد شاهد الصوره الخطوه الثانيه : عمل كود فى حدث فتح الفورم هنعمل كود ليقوم بتعبئة الكمبوبوكس 2 بالبيانات فى العمود A الخاصه باسماء المعارض ولكن دون تكرار امامك طريقتين 1- اذا كان الاسماء للمعارض ثابته ممكن تعملها من خلال المصفوفه زى ماعرفنا قبل كدا زى كدا Private Sub UserForm_Initialize() Dim a As Variant a = Array("اليمن", "مصر", "سوريا", "الجزائر") ComboBox2.List = a End Sub 2- اذا كان الاسماء للمعارض متغيره اذن هنستخدم كود المجموعات مع شرط عدم التكرار فهيكون الكود كدا كما تعلمنا من قبل Private Sub UserForm_Initialize() On Error Resume Next Dim data As Range Dim group1 As Collection Set group1 = New Collection For Each data In Sheet1.Range("a2:a" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row) group1.Add data, data.Text Next data With Me.ComboBox2 For i = 1 To group1.Count .AddItem group1(i) Next i End With End Sub وعند تشغيل الفورم سيكون كالتالى الخطوه الثالثه :- انا عايز عند الاختيار من الكمبوبوكس 2 يتم تعبئة الكمبوبوكس 1 بالاسماء التابعه له تلقائيا اذن هعمل كود فى حدث تغيير الكمبوبوكس 2 ( يعنى كل ما يتم تغيير قيمة الكمبوبوكس 2 تتغير تعبئة الكمبوبوكس 1) هجيب نفس الكود اللى كان فى بداية الدرس اللى هو التعبئة بناء على شرط مع تغيرات بسيطه واحطه فى حدث تغيير الكمبوبوكس 2 كالتالى Private Sub ComboBox2_Change() ComboBox1.Clear On Error Resume Next Dim data As Range Dim group1 As Collection Dim group2 As Collection Set group1 = New Collection Set group2 = New Collection For Each data In Sheet1.Range("b2:b" & Sheet1.Cells(Rows.Count, "b").End(xlUp).Row) If data.Offset(0, -1).Value = ComboBox2.Value Then group1.Add data, data.Text group2.Add data.Offset(0, 1).Value, data.Text End If Next data With Me.ComboBox1 For i = 1 To group1.Count .AddItem group1(i) .List(.ListCount - 1, 1) = group2(i) Next i End With End Sub اللى تم تغييره فى هذا الكود هو اضافه السطر الاول يعنى تنظيف ومسح محتوى قائمة الكمبوبوكس 1 لاستضافه البيانات الجديده حسب التعديل فى الكمبوبوكس 2 وايضا استبدال هذا السطر If data.Offset(0, -1).Value = "الجزائر" Then بالسطر التالى If data.Offset(0, -1).Value = ComboBox2.Value Then جعل الشرط حسب محتوى الكمبوبوكس 2 شاهد الصوره التالية عند اختيار مصر من الكمبوبوكس 2 سيظهر القائمة فى الكمبوبوكس 1 باسماء عملاء مصر فقط شاهد الصوره التالية عند اختيار سوريا من الكمبوبوكس 2 سيظهر القائمة فى الكمبوبوكس 1 باسماء عملاء سوريا فقط **** كدا عرفنا ازاى نقوم بتعبئة الكمبوبوكس بناء على شرط **** وكمان عرفنا ازاى نقوم بتعبئة الكمبوبوكس بناء على كمبوبوكس اخر( وطبعا فى طرق اخرى كتير جدا لتعبئة كمبوبوكس بناء على كمبوبوكس اخر ) يعنى درس النهارده دسم ومحتاج تركيز ولازم تجربو الكلام ده عملى ارجوا يارب ان اكون وفقت بالشرح والى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد وطريقه اخرى من طرق تعبئة الكمبوبوكس انتظرونا تقبلوا تحياتى