محمد حسن المحمد

الصحابي الجليل عمير بن الحمام(رضي الله عنه): في غزوة بدر كان الرسول (صلى الله عليه وآله وسلم) ينادي في المؤمنين ويحمس اصحابه قائلا: "قوموا إلى جنة عرضها السماوات والأرض". فلما سمع هذه الجملة الصحابي عمير بن الحمام رضي الله عنه قال متعجباً {عرضها السماوات والأرض} .. فأجابه رسول الله صلى الله عليه وآله سلم قائلا: {نعم} تلقى عمير رضي الله عنه تلقى الإجابة بسعادة غامرة وحماس منقطع النظير قائلا "بخ بخ" فقال رسول الله صلى الله عليه وسلم ما يحملك على قول بخ بخ هل عندك شك في هذا. فأسرع عمير يقول : لا والله يارسول الله ما قلتها إلا رجاءً أن أكون من أهلها. فقال رسول الله صلى الله عليه وسلم {فإنك من أهلها} في هذه اللحظة علم عمير أنه من أهل الجنة والذي يفصل بينه وبين الجنة الموت فقط لم يعد يستطيع أن يعيش لحظة على ظهر هذه الأرض وكان يمسك بيده بعض التمرا ليتقوى بها على القتال فنظر في هذه التمرات وفكر وللحظة تخيل الفرق بين هذه التمرات وثمار الجنة وطيور الجنة وشراب الجنة وحوض الرسول عليه الصلاة والسلام في الجنة فألقى بالتمرات على الأرض وقال {لإن أنا حييت حتى آكل تمراتي هذه إنها لحياة طويلة } وألقى بنفسه وسط الجموع الكافرة واستشهد رضي الله عنه.

اعذروني إخوتي ..أنفقت رصيد إعجاباتي ..حقكم أن يتم الإعجاب بمشاركاتكم القيمة..عذرا لا بخلا والسلام عليكم.

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

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

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

موعظـــــــــــــــــــــــــــــــــــــــــة أعطى أب لإبنه يوماً كيساً مليئاً بالمسامير وقال له: ( يا بني كلما اهنت شخص أو ضربت شخص أو جرحت شخص اذهب إلى سور الحديقة واطرق فيه مسماراً ) لم يفهم ذلك الولد لماذا طلب والده منه ذلك ولكنه امتثل لأمر والده وأصبح كلما يظلم أحداً أو يصرخ بوجه أحد أو يجرح أحداً يطرق مسماراً في ذلك السور ومع مرور الأيام أصبح الولد أكثر تحكماً في نفسه وانخفض عدد المسامير التي يطرقها كل يوم في السور إلى أن وصل اليوم الذي لم يطرق فيه ذلك الولد أي مسمار في السور فطار الولد من شدة الفرح وذهب إلى والده واخبره بذلك قال له والده: ( أحسنت يا بني أنت الآن شخص تتحكم في نفسك وفي أعصابك ولكن مهمتك لم تنته بعد ) استغرب الولد وقال: وماذا افعل بعد ذلك يا أبي ؟؟؟ قال الأب: ( كل يوم يمضي ولا تزعج أو تجرح أو تظلم فيه أحداً انزع مسماراً من ذلك السور مضت الأيام واستمر الولد في نزع المسامير في كل يوم لا يؤذي فيه أحداً إلى أن وصل اليوم الذي نزع فيه الولد آخر مسمار في ذلك السور فطار الولد من الفرح وذهب إلى والده ليخبره بذلك وعندما أخبره أخذ الأب ابنه إلى السور وقال أحسنت يا بني فأنت لم تصبح شخص متحكم في أعصابك فقط ولكنك أصبحت شخص طيب ولا تؤذي أحداً ولكن انظر إلى الثقوب في السور التي خلفتها تلك المسامير ……… لقد استطعت يا بني أن تنزع المسامير التي طرقتها ولكنك لا تستطيع محو تلك الثقوب التي تركتها المسامير !!! وكذلك هم البشر يا بني عندما تجرح أحدهم فأنت تطرق مسماراً في قلبه قد تستطيع أن تعتذر وتنزع ذلك المسمار ولكنك لن تنزع أثره وسيبقى ذكرى مؤلمة في حياة ذلك الشخص . لذلك يا بني لا تجرح الآخرين أو تؤذيهم بكلماتك فإنك لن تستطيع محو ذلك الجرح إلى الأبد ..

السلام عليكم إن صح عملي بنصيحتك يكون الكود على الشكل التالي: "والله أعلم" Sub SortByLEN() Application.ScreenUpdating = False With Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row) .FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row), Order1:=xlDescending, Header:=xlNo .ClearContents End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته أخي الحبيب أبو البراء وهذا كود آخر بحثت عنه وأضمه إلى باقتكم العطرة لكنني أود مراجعة آخر نقطة وقفت عنها لأنني لم أدركها ولم أستطع تطبيقها ... Sub kTest() Dim Rng As Range Application.ScreenUpdating = 0 Columns(1).Insert: Rows(1).Insert [a1] = "temp": [b1] = "texts" Set Rng = Range("a1", Range("b" & Rows.Count).End(xlUp)) With Rng .Offset(1).Resize(.Rows.Count - 1, 1).Formula = "=len(b2)" .Sort .Cells(2, 1), xlDescending, Header:=xlNo .Columns(1).Delete .Rows(1).Delete End With Application.ScreenUpdating = 1 End Sub

بارك الله بإخوتي الكرام الذين شاركونا هذا الموضوع ...الحمد لله ...الخير بأمة محمد إلى يوم القيامة... والسلام عليكم.

السلام عليكم أخي الحبيب أبو البراء ...جزاكم الله خيراً..عمل مميز

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

هل يتم ذلك بإيقاف تحديث الشاشة ثم إعادة تحديثها بعد تنفيذ الكود ...يرجى الإفادة. وأما المدى الديناميكي ...أكيد بحاجة دراسة.

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

Sub SortByLEN() With Range("B1:B10") .FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub السلام عليكم ورحمة الله وبركاته ..هذا ما توصلت إليه أخيراً ...وقد عمل بشكل صحيح والسلام عليكم أتعبتكم معي...سامحوني.

للأسف لم يتم الفرز بهذه الطريقة Sub SortByLEN() With Range("A1:B10") .FormulaR1C1 = "=LEN(RC[-1])" .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub

المشكلة في هذا السطر Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Sub SortByLEN() With Range("A1:B10") .FormulaR1C1 = "=LEN(RC[-1])" .Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo .ClearContents End With End Sub يرجى المساعدة بتصحيحه..جزاكم الله خيراً.

السلام عليكم أخي الحبيب أبو البراء تأخرت عليك لا تؤاخذني.. Sub SortByLEN() Range("B1:B10").FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Range("B1:B10").ClearContents End Sub بارك الله بكم وبعلمكم ونفع به وجعله ذخراً لكم يوم القيامة ..آمين.

السلام عليكم أخي الحبيب أبو حمزة...ربنا يبارك لكم بحمزة ومن معه ...آمين درر سنية تتحفنا بها لتجعل يومنا عامراً بالتفاؤل ...جزاكم الله خيراً وأحسن إليكم...والسلام عليكم.

السلام عليكم ...تم التعديل ..جزاكم الله خيراً

السلام عليكم ورحمة الله وبركاته أخي الحبيب أبو البراء...أرجو أن يكون حلاً مناسباً بعد جهد جهيد...العلم في الصغر كالنقش في الحجر ..أما في الكبر فهو كوخز الأبر.. Sub SortByLEN() Range("B1").Select Range("B1").FormulaR1C1 = "=LEN(RC[-1])" Selection.AutoFill Destination:=Range("B1:B10") Range("A1:B10").Sort Key1:=Range("B1:B10"), Order1:=xlDescending, Header:=xlNo Range("B1:B10").ClearContents End Sub فرز حسب الأحرف تنازلياً.rar

السلام عليكم إن شاء الله تعالى بعد صلاة الجمعة

السلام عليكم طبقت ما ذكرت لي بموديول عن طريق تسجيل ماكرو أرجو أن ينال إعجابكم فرز حسب الأحرف تنازلياً.rar

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً على تفعيل العمل والطلب من الأعضاء الكرام التفاعل الإيجابي بالموارد المتاحة قمت بدوري بالفرز التنازلي حسب عدد الأحرف باستخدام عمود مساعد يتعلق بعمل الدالة LEN كمساهمة بسيطة والسلام عليكم. فرز حسب الأحرف تنازلياً.rar