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

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

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

جرب الكود بهذا الشكل حاول أن تبتعد عن تنشيط أوراق العمل أثناء كتابة الكود ..من الأفضل استخدام اسم ورقة العمل في أسطر الكود قم بالإطلاع على الكود وعدل الكود الثاني بنفس الطريقة ..أو يمكن استخدام زر واحد وكود واحد (فقط تغير الخلية F1) Sub قائمة_مستوى_1() Dim R As Integer, RA As Integer, RB As Integer, RC As Integer, FS As Integer Application.ScreenUpdating = False Sheets("قائمة الفصل").Range("C9:J58").ClearContents Sheets("قائمة الفصل").Range("D3") = "المستوى الأول" RA = 9: RB = 9: RC = 9 FS = Sheets("قائمة الفصل").Range("F1") With Sheets("سجل القيد") For R = 9 To 408 If .Cells(R, 6) = "1" And FS = "1" Then .Range("E" & R).Copy Sheets("قائمة الفصل").Range("C" & RA).PasteSpecial xlPasteValues .Range("H" & R).Resize(1, 7).Copy Sheets("قائمة الفصل").Range("D" & RA).PasteSpecial xlPasteValues RA = RA + 1 ElseIf .Cells(R, 6) = "2" And FS = "2" Then .Range("E" & R).Copy Sheets("قائمة الفصل").Range("C" & RA).PasteSpecial xlPasteValues .Range("H" & R).Resize(1, 7).Copy Sheets("قائمة الفصل").Range("D" & RA).PasteSpecial xlPasteValues RA = RA + 1 End If Next R End With Application.ScreenUpdating = True End Sub

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

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

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

مشكور على الورد يا مخ(تار) .. تقبل تحياتي

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

أخي الكريم وائل ضع الكود التالي في حدث المصنف Private Sub Workbook_Open() ThisWorkbook.RemovePersonalInformation = False End Sub

أخي الكريم أي تكست بوكس تقصد ...هناك تكست بوكس يمكن رسمه على ورقة العمل بشكل مباشر Textbox activex control وهناك تكست بوكس يرسم على الفورم؟ هذا هو السؤال الأول سؤالي الثاني .. ماذا تقصد بكلمة formula_value في الثلاثة أسطر في المشاركة الأولى؟ حاول توضح ويا ريت ملف مرفق

يمكنك الإطلاع على الرابط التالي فيه حل للمشكلة من هنا أو حل آخر شوف الفيديو

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

إخواني ياسر العربي وخالد الرشيدي يفضل عدم استخدام أكواد التحديد في الكود بمعنى في هذا السطر على سبيل المثال Cells(a + 1, 1).Resize(1, 4).Select Selection.Copy يمكن استخدام هذا السطر مباشرةً بدون تحديد بهذا الشكل Cells(a + 1, 1).Resize(1, 4).Copy وفي هذين السطرين sheet1.Activate ActiveCell.EntireRow.Delete يمكن استخدام سطر واحد فقط دون تحديد ورقة العمل لأن الكود ينفذ من ورقة العمل النشطة Cells(a + 1, 1).EntireRow.Delete تقبلوا تحياتي

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

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

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

إليك الرابط التالي من هنا

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

أخي الكريم محمد يرجى تغيير اسم الظهور للغة العربية إليك الملف المرفق فيه تطبيق الكود .. Convert Text To Numbers YK.rar

أخي الكريم ارفق الملف المراد العمل عليه .. جرب الكود التالي عله يفي بالغرض Sub ConvertTextToNumber() Dim R As Range On Error Resume Next For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants) If IsNumeric(R) Then R.Value = Val(R.Value) Next R End Sub

إخواني وأحبابي في الله تتقدم إدارة الموقع بالتهنئة لكلٍ من العضوين الكريمين :: خالد الرشيدي *** ياسر العربي فنتقدم لهما بالتهنئة الحارة من قلوبنا ، ونتمنى لهما مزيد من التفوق والتميز .. مع تحيات أخوكم أبو البراء

أخي الكريم أنس بارك الله فيك على هذا الموضوع المتميز ..موضوع في غاية وقمة الجمال والروعة أخي الحبيب مختار تفضل هذا الكود (مع حفظ الملفات المفتوحة ..Log off بشكل مؤقت) #If VBA7 Then Private Declare PtrSafe Function LockWorkStation Lib "user32.dll" () As Long #Else Private Declare Function LockWorkStation Lib "user32.dll" () As Long #End If Sub LockStation() LockWorkStation End Sub

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

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

أخي الكريم جرب الكود بهذا الشكل ويرجى إرفاق ملف Sub myTest() Dim gCell As Range, fCell As Range, iCell As Range Dim positivevalue As Long, negativevalue As Long, positivevolume As Long, negativevolume As Long Dim resultevalue1 As Long, resultevalue2 As Long For Each gCell In Range(Range("G2"), Range("G5").End(xlDown)) For Each fCell In Range(Range("F2"), Range("F5").End(xlDown)) For Each iCell In Range(Range("I2"), Range("I5").End(xlDown)) If iCell >= 0 Then positivevalue = positivevalue + gCell positivevolume = positivevolume + fCell ElseIf iCell < 0 Then negativevalue = negativevalue + gCell negativevolume = negativevolume + fCell End If resultevalue1 = positivevalue / positivevolume resultevalue2 = negativevalue / negativevolume Next Next Next End Sub