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

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

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

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

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

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

عوداً حميداً أخي الكريم وائل فينك غطسااااااااان من فترة ؟! لعل غيابك عن المنتدى خير إن شاء الله سلم لي على الأسايطة نفر نفر

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

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

أخي الكريم إيهاب أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية ومراجعة موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى بالنسبة لطلبك .. اعمل كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code .. وضع الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$IM$1" Then Dim str As String Application.EnableEvents = False If IsNumeric(Target) And Target.Value <> 0 Then Cells.EntireColumn.Hidden = False str = Split(Cells(1, Target.Value).Address, "$")(1) Columns("A:" & str).Hidden = True ElseIf Target.Value = 0 Then Cells.EntireColumn.Hidden = False End If Application.EnableEvents = True End If End Sub تقبل تحياتي

أخي الكريم أعتقد أن الموضوع مكرر .. يرجى عدم طرح الموضوع أكثر من مرة !! الموضوع الآخر أعتقد بنفس عنوان الملف المرفق "بحث في قائمة بأكثر من متغير" كلف نفسك وتصفح أول أربعة صفحات في المنتدى لتجد بغيتك

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

أخي العزيز صلاح حاول أن تقوم بتوضيح طلبك بشكل أفضل .. لم أفهم وجهة نظرك أو طلبك في الموضوع بشكل كامل ولكن على حسب ما أعتقد - وإن كنت لا أحب تقديم الحلول إطلاقاً على حساب التخمين والاحتمالات - إليك الكود التالي عله يفي بالغرض .. يقوم الكود بعمل حلقة تكرارية في ورق العمل الثانية ويقوم بالبحث باستخدام دالة Vlookup ولكن باستخدام الكود .. Sub Test() Dim Ws As Worksheet, Sh As Worksheet, Rng As Range, I As Long Set Ws = ورقة1: Set Sh = ورقة2 Set Rng = Ws.Range("A2:B" & Ws.Cells(Rows.Count, 1).End(xlUp).Row) For I = 2 To Sh.Cells(Rows.Count, 1).End(xlUp).Row On Error Resume Next Sh.Cells(I, 2).Value = Application.WorksheetFunction.VLookup(Sh.Cells(I, 1).Value, Rng, 2, 0) Next I End Sub أرجو أن يكون المطلوب إن شاء الله تقبل تحياتي

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

هذا رابط لموقع رفع خارجي يتم فيه رفع الملفات بشكل مؤقت من هنا وإليك صورة توضيحية للخطوات في صورة واحدة ..

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

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

أخي الكريم أحمد حبيبة جرب الكود التالي ..يمكنك تغيير اسم ورقة العمل في السطر المشار إليه في التعليق Sub SplitSpecificSheet() Dim xPath As String Dim SH As Worksheet xPath = Application.ActiveWorkbook.Path Set SH = Sheets("Data") 'غير اسم ورقة العمل المراد تصديرها Application.ScreenUpdating = False Application.DisplayAlerts = False With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تقبل تحياتي

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

بارك الله فيك أخي الكريم عاطف يرجى وضع الأكواد بين أقواس الكود لتظهر بشكل منضبط من خلال هذه العلامة <>

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

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

أخي الكريم لا أحب إرفاق أكثر من ملف مختلف في موضوع واحد .. لأنه بهذا الشكل قد تغيرت الفكرة وتغير الطلب تماماً .. عملت على الملف الأول فقط .. إذا أردت أن تعمل على الملف الثاني فاطرح موضوع مستقل بذلك الطلب .. إليك الكود التالي ..ضع الكود في حدث الفورم واحذف الكود القديم أولاً Private Sub CommandButton1_Click() Dim cMis As New Collection, D1 As Date, D2 As Date, N&, R&, V, VD, VN If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub UserForm2.ListBox1.Clear D1 = CDate(TextBox1) D2 = CDate(TextBox2) With Sheet1.Cells(1).CurrentRegion.Columns VN = .Item(1).Value VD = .Item(6).Value End With On Error Resume Next For R = 1 To UBound(VN) If VarType(VD(R, 1)) = vbDate Then If VD(R, 1) >= D1 And VD(R, 1) <= D2 Then Err.Clear cMis.Add Array(VN(R, 1), 1), VN(R, 1) If Err.Number = 457 Then V = cMis(VN(R, 1)) V(1) = V(1) + 1 cMis.Remove V(0) For N = 1 To cMis.Count If V(1) > cMis(N)(1) Then cMis.Add V, V(0), N: Exit For Next N If N > cMis.Count Then cMis.Add V, V(0) End If End If End If Next R On Error GoTo 0 If cMis.Count Then For Each V In cMis UserForm2.ListBox1.AddItem V(0) & " : عدد المهمات ( " & V(1) & " )" Next V Set cMis = New Collection Else MsgBox "No Match !" End If Set cMis = Nothing End Sub Private Sub CommandButton2_Click() Me.TextBox1.Value = Format(Date, "dd/mm/yyyy") Me.TextBox2.Value = Format(Date, "dd/mm/yyyy") End Sub أرجو أن يكون المطلوب تقبل تحياتي

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

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

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