نجوم المشاركات

بس للعلم ، كود تغيير الاسم فيه شئ جميل للنظر فيه ، فالسؤال هو : اذا فتحت ملف اكسس مثلا ، فهل تستطيع ان تغير اسمه وهو مفتوح؟ الجواب لا ، فهنا انا ، غيرت اختيار الصورة (يعني كأنّي كبست على صورة ثانية) 'select another file in the listbox, so that this file is no longer in-use عندها ، طلبت من الاكسس ان لا يسمح لك ان ترى ما يحدث (يعني لما اكبس الزر لرؤية صورة اخرى ، فالمفروض ترى صورة اخرى في النموذج ، مما قد يربك المستخدم) ، وذلك بعدم تغيير آخر شكل للنموذج ، والامر هو Me.Painting = False ، وعندها عملت التغييرات ، ولما خلصت ، طلبت من اكسس ان يعرض الشكل الصحيح للنموذج Me.Painting = True للعلم جعفر

=LEN(TRIM(A1))-LEN(SUBSTITUTE(TRIM(A1)," ",""))+1 لمعرفة عدد الكلمات هذه المعادلة لمعرفة عدد الفراغات هذه الثانية =LEN(TRIM(A1))-LEN(SUBSTITUTE(TRIM(A1)," ",""))

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

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

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

أخى الفاضل أولا : يرجى تغيير اسم الظهور الى اللغة العربية لسهولة التواصل ثانيا : استخدم المعادلة الآتية فى الخلية B2 ثم اسحبها الى بقية الخلايا =MID($A2;COLUMNS($B2:B2);1)

العنوان الموضوع من قبل كلمة واحدة فقط "سؤال" وكما تعلم "السؤال لغير الله مذلة" .. طبعاً إلا السؤال لطلب العلم فهو أمر محبوب تقبل تحياتي

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

اسف خطأ متوقع ركزت ع الترتيب فقط لم تاتي فكرة لعلاج المشكلة بطريقة احترافية المهم عدلت بفكرة بسيطة كدا تقوم باللازم لعلها تناسبك وبعدين يامعلم حمادة متقولشي كدا براحتك احنا معاك لو ظهر الف مشكلة وسعت مني صح خليهم ميت مشكلة كويس كدا وشكرا نتيجة بالدرجات.rar

السلام عليكم ورحمة الله وبركاته باب بيان أنه لا يدخل الجنة إلا المؤمنون وأن محبة المؤمنين من الإيمان وأن إفشاء السلام سببا لحصولها 54 حدثنا أبو بكر بن أبي شيبة حدثنا أبو معاوية ووكيع عنالأعمش عن أبي صالح عن أبي هريرة قال قال رسول الله صلى الله عليه وسلم لا تدخلون الجنة حتى تؤمنوا ولا تؤمنوا حتى تحابوا أولا أدلكم على شيء إذا فعلتموه تحاببتم أفشوا السلام بينكم وحدثني زهير بن حرب أنبأنا جرير عن الأعمش بهذا الإسناد قال قال رسول الله صلى الله عليه وسلم والذي نفسي بيده لا تدخلون الجنة حتى تؤمنوا بمثل حديث أبي معاوية ووكيع قوله - صلى الله عليه وسلم - : ( لا تدخلون الجنة حتى تؤمنوا ، ولا تؤمنوا حتى تحابوا أولا أدلكم على شيء إذا فعلتموه تحاببتم : أفشوا السلام بينكم ) وفي الرواية الأخرى : ( والذي نفسي بيده لا تدخلون الجنة حتى تؤمنوا ) هكذا هو في جميع الأصول والروايات ولا تؤمنوا بحذف النون من آخره وهي لغة معروفة صحيحة . وأما معنى الحديث فقوله - صلى الله عليه وسلم - : ولا تؤمنوا حتى تحابوا معناه لا يكمل إيمانكم ولا يصلح حالكم في الإيمان إلا بالتحاب . وأما قوله - صلى الله عليه وسلم - : لا تدخلون الجنة حتى تؤمنوا فهو على ظاهره وإطلاقه فلا يدخل الجنة إلا من مات مؤمنا وإن لم يكن كامل الإيمان ، فهذا هو الظاهر من الحديث . وقال الشيخ أبو عمرو - رحمه [ ص: 228 ] الله - . معنى الحديث لا يكمل إيمانكم إلا بالتحاب . ولا تدخلون الجنة عند دخول أهلها إذا لم تكونوا كذلك . وهذا الذي قاله محتمل . والله أعلم . وأما قوله : ( أفشوا السلام بينكم ) فهو بقطع الهمزة المفتوحة . وفيه الحث العظيم على إفشاء السلام وبذله للمسلمين كلهم ;من عرفت ، ومن لم تعرف ، كما تقدم في الحديث الآخر .والسلام أول أسباب التألف ، ومفتاح استجلاب المودة . وفي إفشائه تمكن ألفة المسلمين بعضهم لبعض ، وإظهار شعارهم المميز لهم من غيرهم من أهل الملل ، مع ما فيه من رياضة النفس ، ولزوم التواضع ، وإعظام حرمات المسلمين وقد ذكرالبخاري - رحمه الله - في صحيحه عن عمار بن ياسر - رضي الله عنه - أنه قال : ( ثلاث من جمعهن فقد جمع الإيمان : الإنصاف من نفسك ، وبذل السلام للعالم ، والإنفاق من الإقتار. روى غير البخاري هذا الكلام مرفوعا إلى النبي - صلى الله عليه وسلم - . وبذل السلام للعالم ، والسلام على من عرفت ومن لم تعرف ، وإفشاء السلام كلها بمعنى واحد . وفيها لطيفة أخرى وهي أنها تتضمن رفع التقاطع والتهاجر والشحناء وفساد ذات البين التي هي الحالقة ، وأن سلامه لله لا يتبع فيه هواه ، ولا يخص أصحابه وأحبابه به . والله سبحانه وتعالى أعلم بالصواب .

أخي الكريم سامي الحميدي جرب الكود التالي عله يفي بالغرض Sub LoopThroughSheets() Dim Ws As Worksheet, Sh As Worksheet, I As Long, Cell As Range Set Ws = Sheet1 For Each Sh In ThisWorkbook.Worksheets For Each Cell In Sh.Range("E7:E" & Sh.Cells(Rows.Count, "B").End(xlUp).Row) If Not IsEmpty(Cell) And IsDate(Cell) And CLng(Date) - CLng(Cell) >= 30 Then Ws.Cells(I + 6, 1).Value = I + 1 Ws.Cells(I + 6, 2).Value = Sh.Name Ws.Cells(I + 6, 3).Value = Cell.Offset(, -3).Value Ws.Cells(I + 6, 4).Value = Cell.Value I = I + 1 End If Next Cell Next Sh End Sub تقبل تحياتي Loop Through Sheets & Check Date Condition YasserKhalil.rar

بسم الله الرحمن الرحيم يا فتّاح يا عليم يا رزّاق يا كريم

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

اخواني الاكارم البرنامج التالي يخص محلات بيع النظارات و اطباء العينية و هو مأجور و ليس مجاني الأجرة ( دعوة صالحة لي و لمعلمي ( أبو آدم )) :rol: اترككم مع المرفق و انا بانتظار الردود ( في حال وجود خطأ لا سمح الله ) -------------------------------------------------------------------------------------------------------------------------- اعتذر لجميع الاخوة يرجى اضافة المرفق التالي مع المرفق الأول وهو وحدة نمطية لمنع التحرك بين السجلات عن طريق دولاب الفارة فقط استخرج المف المرفق وضعه في فولدر البرنامج MyCustomerData.rar std.rar

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

السلام عليكم اخى الكريم .. لم تضع تصور للفورم المطلوب ..ووضعت ملف به اسماء المعلمين من خلال قائمة منسدلة محذوف مرجعها .. عموما اليك الملف التالى .. جربة وابدى ملاحظاتك.. اما ان لم يظهر معك نتائج احد الاسماء فى احد الايام او كل الايام .. اعد كتابة الاسم بجدوا الحصص او تجعل للقائمة المنسدلة مرجع Book1_3.zip

بالنسبة للأسماء المركبة سيكون الأمر بنسبة كبيرة ولكن لن تكون بنسبة 100% ... فكرتك جميلة ولكن مرهقة في أنك ستضظر إلى كتابة 1 أو 2 لكل اسم ...فهل هذا منطقى؟

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

السلام عليكم ماشاء الله البيت امتلأ علينا بالحبايب منور اخي ياسر منور أخى أحمد تشجيعكم لنا رجعنى 40 سنة لزمان لما كان عندى 11 سنة أنا قطعتها علشان ماحدش يحسبها إنما لو ليها معادلة أو كود ماشى !! نورتونا ياحبايب بالمناسبة ياأخ ياسر لو تكرمت وشاركت فى ملف التدرج هل يمكن كتابة 7/1 من كل عامفى صفوف متتالية وعند إدخال أى تاريخ مابينهمافى صفحة الإدخال يدخل فى موقعة عن طريق إدراج الصفوف وربنا يوفقك للخير دائماً

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

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

أخي الكريم سامي أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية كما يرجى توضيح المطلوب أكثر ..هل الأرقام التي سيتم معها أرقام ثابتة في الطول (7 أرقام لكل رقم)؟ .. هل هناك بيانات أخرى غير رقمية ضمن النطاق ؟ .. هل تريد توزيع الأرقام في الأعمدة المجاورة وفقط ؟ أم أنك تريد توزيعها بشروط ؟؟ وإذا كانت الشروط كما ذكرت أن الأرقام لابد أن تحتوي على 0 أو 2 أو 5 أو 8 ..فماذا لو لم ينطبق الشرط؟

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

تقبلتها

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

أهلا بك أخ تامر انظر مرفقك بعد التعديل وإجراء بعض التعديلات على الجداول (موضح بداخلها).. وتم تغيير مسمى حقلي مربع التحرير والسرد إلى ComboList1 و ComboList2 حيث ComboList2 الذي يعتمد على ComboList1 بداخل مصدره الاستعلامي الآتي: [Forms]![نوع]![ComboList1] على أن يجلب النتائج حسب [النماذج]![نوع] وهو اسم النموذج لديك والذي به![ComboList1 ] وهو مربع التحرير والسرد الذي يعتمد عليه ووضعنا كود للحقل ComboList1 بعد التحديث على أن يجلب النتائج حسب الاستعلام السابق الموجود في ComboList2 وبالبحث ستجد أمثلة كثيرة عن طلبك والأفضل أن تبعتد عن المسميات العربية والمسافات بين الكلمات تحياتي قائمه_منسدله.rar

أخي الكريم يتوجب عليك تعديل الإعدادت الرئيسية في جهازك وتختار الأرقام الهندية بدل الأرقام العربية

استعمل هذه المعادلة (اذا انت البيانات في العامود A) لمعرفة عدد الخلايا التي نحنوي على نصوص =COUNTA(A:A)-COUNT(A:A) و هذه لمعرفة عدد الخلايا التي نحنوي على ارقام =count(A:A)

تأكد فبل القيام بعملية النسخ ان الكيبورد موضوغ غلى اللغة العربية

الموضوع بسيط انت هتعتمد على روابط الشبكة للوصول لملفاتك جرب المرفق كدا TEST.rar

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

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

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

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

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

الأخ الكريم أبو يحيى الحمد لله أن تم المطلوب على خير لي طلب فضلاً لا أمراً هلا أزلت الرقم 1 في نهاية اسم الظهور لديك ..نريد أن يكون اسم العضو معبر عن شخصه الكريم كما هو الحال في أسماء الظهور لمعظم الأعضاء تقبل تحياتي

وعليكم السلام ايش رايك ، حذفت حقل مسار الصورة: . وحذفت زر فتح الصورة: . وهذا هو كود النموذج كاملا: Option Compare Database Private Sub clase_form_Click() DoCmd.Close End Sub Private Sub Form_Current() Dim imagepath As String '1 imagepath = Application.CodeProject.Path '2 imagepath = imagepath & "\Photo\" 'if the photo Dir dose not exist, creat it If Dir(imagepath, vbDirectory) = "" Then MkDir imagepath End If '3 imagepath = imagepath & [E_number] & "\" 'if the [code] Dir dose not exist, creat it If Dir(imagepath, vbDirectory) = "" Then MkDir imagepath End If 'Place the imagepath in the listbox tag Me.lst_Files.Tag = imagepath 'cleaning up Me.lst_Files.RowSourceType = "Value List" Me.lst_Files.RowSource = "" Me.imageframe.Picture = "" 'Directory file to the listbox strFile = Dir(imagepath & "*.*") Do Until strFile = "" Me.lst_Files.AddItem Item:=strFile strFile = Dir() Loop End Sub Private Sub lst_Files_Click() 'show the picture Me.imageframe.Picture = Me.lst_Files.Tag & Me.lst_Files End Sub جعفر 296.imageListBox.accdb.zip

السلام عليكم لاثراء الموضوع جرب أخى هذه المعادلة =INDEX($A$1:$A$18;SMALL(IF(ISNUMBER($A$1:$A$18);ROW($A$1:$A$18));ROWS($G$2:G2))) New Microsoft Excel Worksheet.rar

اخي الغالي ابو البراء التعديل هنا Private Sub ButtonFind_Click() Dim Lr As Long, R As Long Dim iNx As Integer Me.ComboBox1.Clear جعلنا iNx =33 iNx = 33 لانه هنا يعتمد على الليست اندكس في الكمبوبوكس2 وانت مسيبتش غير تلاته بس انا ريحت وكتبت هما كام وخلاص :) 'iNx = Me.ComboBox2.ListIndex + 1 With æÑÞÉ1 Lr = .Cells(.Rows.Count, "A").End(xlUp).Row For R = 2 To Lr If InStr(.Cells(R, iNx).Value, Me.TextFind.Value) Then Me.ComboBox1.AddItem .Cells(R, iNx).Value Me.ComboBox1.List(Me.ComboBox1.ListCount - 1, 1) = R End If Next End With With Me.ComboBox1 If .ListCount Then .ListIndex = 0: .DropDown Else kh_delete End With End Sub

سليم حاصبيا ياسر خليل أبو البراء أعطوني حرف السّين المشترك بينكما لأصبح مبدع مثلكما بارك الله فيكما و لكما في صحّتكما و أوقاتكما و أولادكما و أسرتيْكما الكريمتيْن باسم الله ما شاء الله تبارك الله إبداع ما فوقه إبداع أعمال و الله راقية فائق إعجاباتي

أخي الكريم أبو خالد يرجى تغيير اسم الظهور للغة العربية إليك حل بالأكواد إثراءً للموضوع Sub Test() Dim I As Long, FirstName As String, FatherName As String, Str As String For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row FirstName = Kh_Names(Cells(I, 1), 1) FatherName = Cells(I, 2) Str = Mid(Cells(I, 1), Len(FirstName) + 1) Cells(I, 4).Value = FirstName & " " & FatherName & Str Next I End Sub Function Kh_Names(FullName As String, ParamArray iNdex1()) As String Dim I As Integer Dim Kh_Split, MyArray, Ar Dim Kh_String As String, SN As String, RE As String On Error GoTo Err_Kh_Names MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الحق", " النصر", " العهد", " النور", " بالله") SN = Application.WorksheetFunction.Trim(FullName) For Each Ar In MyArray RE = Replace(Ar, " ", "^") SN = Replace(SN, Ar, RE) Next Kh_Split = Split(SN, " ", , vbTextCompare) On Error Resume Next For I = 0 To UBound(iNdex1) Kh_String = Kh_String & " " & Kh_Split(iNdex1(I) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function تقبل تحياتي

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

السادة الكرام قمت بتنصيب اوفيس 2013 بدلاً من 2007 وكانت النتيجة ممتازة بقي أن أتأكد من المشلكة. هل هي من نسخة اوفيس 2007 التي لدي ؟ أم المشكلة من اوفيس 2007 عموماً تحياتي للجميع

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

إنت مش ناسي إخوانك سواء الاعدادي أو الابتدائي .. كدا الجماعة بتوع الثانوي هيزعلوا تقبل تحياتي

الكود التالي يقوم بالمعالجة في عمود الاسماء بالتالي لا يحتاج الى عمود اضافي Sub AL_KHALEDI() Set Rn = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) Lr = Rn.Rows.Count ReDim Arr(Lr - 1) For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", 1) If Not IsError(S) Then T1 = Mid("أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Range("B2:J2").Resize(Lr).Sort Range("B2"), xlAscending A = 0 For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", 1) If Not IsError(S) Then T1 = Mid("أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Set Rn = Nothing: Erase Arr End Sub

السلام عليكم احسنت اخي الحبيب الخالدي ....حفظكم الله كود رائع جزاكم الله خيرا تقبلوا تحياتي وشكري