ياسر خليل أبو البراء

وبارك الله فيك أخي الفاضل ونورت المنتدى وشرفت بين إخوانك تقبل تحياتي

أخي الحبيب إبراهيم مزيد من التوضيح ...مزيد من التوضيح

بعد إذن العمالقة .. (هذا اللغز للمبتدئين فقط) اختصر الكود التالي في سطر واحد Sheet1.Range("A1:A20").Copy Sheet1.Range("B1").PasteSpecial Application.CutCopyMode = False ممنوع الإجابة من الأعضاء المميزين أو الخبراء أو المشرفين ..هذا اللغز للمبتدئين في عالم البرمجة الكود يقوم بنسخ النطاق A1:A20 إلى الخلية B1 كأول خلية يتم لصق البيانات بها ، ثم يتم إلغاء خاصية النسخ واللصق ..أي مسح الحافظة Clipboard المطلوب : اختصار الكود في سطر واحد متجاوزين الحافظة (بدون تخزبن البيانات في الحافظة) .. ممنوع استخدام العلامة : حيث أن هذه العلامة تستخدم لكتابة سطر جديد في نفس السطر هكذا Sheet1.Range("A1:A20").Copy: Sheet1.Range("B1").PasteSpecial: Application.CutCopyMode = False هذا غير مسموح به ..غير مسموح استخدام علامة : في انتظار إجابات الأعضاء ..(جمد قلبك وحاول ..الموضوع بسيط ..)

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

نورت الموضوع أستاذي الكبير عبد الله باقشير مشكور على تشريفك للموضوع .. ويا ريت متحرمناش من لغز (بس يكون على أد مستوانا .. ) الأخ سليم تفضل المرفق التالي فيه ما تريد تقبلوا تحياتي Merge UnMerge YK.rar

بسم الله ما شاء الله ...تمام تمام تمام الله ينور عليك يا أبو صلاح ..بارك الله فيك ملف في منتهى الروعة

أين الكود أخي الفاضل؟ الملف محفوظ بصيغة لا تحتوي على أية أكواد .........

أخي أحمد غانم جرب الكود التالي لعله يفي بالغرض Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim OffsetCol As Long, X As Long Static ColorRange As Range, ColorIndexes() As Variant Const COLUMNSDISPLAYED As Long = 60 Application.ScreenUpdating = False If Not ColorRange Is Nothing Then For X = 1 To ColorRange.Columns.Count ColorRange.Cells(X).Interior.ColorIndex = ColorIndexes(X) Next Else On Error Resume Next Set ColorRange = Range(Sheet2.Cells(1).Value) On Error GoTo 0 If Not ColorRange Is Nothing Then For X = 1 To ColorRange.Columns.Count ColorRange.Cells(X).Interior.ColorIndex = CLng(Split(Sheet2.Cells(2).Value, ",")(X - 1)) Next End If End If OffsetCol = Application.Max(Target.Column - (COLUMNSDISPLAYED \ 2), 0) Set ColorRange = Range(Cells(Target.Row, 1 + OffsetCol), Cells(Target.Row, Application.Min(Columns.Count, Target.Column + (COLUMNSDISPLAYED \ 2)))) ReDim ColorIndexes(1 To ColorRange.Columns.Count) For X = 1 To ColorRange.Columns.Count ColorIndexes(X) = ColorRange.Cells(X).Interior.ColorIndex Next Sheet2.Cells(1).Value = ColorRange.Address(0, 0, , -1) Sheet2.Cells(2).Value = CStr(Join(ColorIndexes, ",")) ColorRange.Interior.ColorIndex = 36 Application.ScreenUpdating = True End Sub

الأخ الحبيب صلاح مفيش غيرك بيعمل الواجب ولا ايه ؟؟؟ أشكرك على كلماتك الطيبة الرقيقة وجزيت خير الجزاء على حسن المتابعة .. بالنسبة للواجب يبدو إنك مذاكرتش كويس ..راجع الحلقة مرة تانية .. الاسم اللي في الواجب مجرد مثال ::: أنا أريد كود ينطبق على أي اسم مركب من اسمين Yasser Khalil Salah Salem Ahmed Kamal Tamer Salim Hossam Essa وهكذا .. أي أن الكود يمكنه التعامل مع أي اسم عموما بارك الله فيك ..أعتقد أن فكرة الواجب قد وصلتك الآن .. في انتظار التصحيح (صحح لنفسك بنفسك) .. لو عايز واجب أصعب اكتب الأسماء اللي فاتت كلها في النطاق A1:A10 مثلا وقم بعمل المطلوب في النطاق B1:B10

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

أخي الحبيب سليم بلاش الألغاز الصعبة دي ..عايزين حاجة سهلة كدا على أد مستوانا .. عموما شوف دا ينفع (مش عاجبني بس أهو حاجة نتقدم بيها عشان الصقر مياكلش وشي) Merge UnMerge.rar

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

تفضل أخي الغالي (وخلي الباشمهندس طارق للأمور الصعبة التي لا يستطيع أحد سواه أن يقوم بها) Bill Backup.rar

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

ارفق ملف ليتضح المطلوب وليعمل الجميع على مساعدتك بشكل أسرع .. لا تجعل من يريد المساعدة ينفر من الموضوع أخي الحبيب

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

جرب الملف المرفق تاريخ الطالب.rar

المشرفين ؟؟؟؟؟؟؟؟!!!! أنا

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

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

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

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

بارك الله فيك أخي الحبيب مختار طبقت ما قلته بالحرف الواحد وتمت إضافة الـ AdIns بنجاح عندما أقوم بإدراج رمز رياضي يظهر الرمز بحرف إنجليزي وليس الرمز ..جربت أغير نوع الخط ولم يفلح .. هل هناك شيء مفقود ؟؟

جرب نفس كودك بس غير كلمة Format Private Sub Worksheet_SelectionChange(ByVal Target As Range) [A1:A2] = Date [A2].NumberFormat = "dddd/dd/mmmm/yyyy" End Sub

هذا التنسيق يقرأه كتاريخ dd/mmm/yyyy جرب اعمل دبل كليك في الخلية B2