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

نهنئ أنفسنا بانضمام الأخ جعفر لفريق الموقع أهلا وسهلا

بعد اذن الاستاذ محمد فيه طريقة اسهل التاريخ.rar

تفضل اخي وجدت هذا الكود لك يستطيع الاخوة تعديله لك كما ترغب بعد ارفاق وتوضيح طلبك باذن الله image.rar

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

أخي الكريم عبد العزيز جرب الكود التالي في وجود الدالة المعرفة ... Sub TestRun() Dim I As Integer For I = 2 To Cells(Rows.Count, "B").End(xlUp).Row If Kh_Names(Cells(I, "B"), 1) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) ElseIf Kh_Names(Cells(I, "B"), 1, 2) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "G") = Kh_Names(Cells(I, "B"), 2) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "G") = Kh_Names(Cells(I, "B"), 4) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4, 5) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "F") = Kh_Names(Cells(I, "B"), 4) Cells(I, "G") = Kh_Names(Cells(I, "B"), 5) End If Next I End Sub وهذا سيستلزم أن تقوم بالنقر على زر الأمر لكي يقوم الكود باختبار كل اسم على حدا .. حسب ما سترى في الملف المرفق أرجو أن يفي بالغرض Split Compound Names UDF Function V2.rar

أخي الكريم عبد العزيز إليك دالة معرفة تقوم بالأمر ونسبة نجاحها حوالي 95% .. الأمر لن يسلم من بعض الأخطاء البسيطة ... توضع الدالة المعرفة في موديول جديد .. Function Kh_Names(FullName As String, ParamArray Index1()) As String Dim I As Integer Dim Kh_Split, MyArray, Arr 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 Arr In MyArray RE = Replace(Arr, " ", "^") SN = Replace(SN, Arr, 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 وإليك الملف المرفق فيه توضيح لكيفية استخدام الدالة أرجو أن تفي بالغرض تقبل تحياتي Split Compound Names UDF Function.rar

أخي الكريم وائل جرب هذا الكود لربما يكون هناك مشاكل في إعدادات الإكسيل نفسه الكود مجرب ويحل الكثير من المشكلات الغريبة التي تحدث ..إذا استمرت المشكلة فعليك بنصيحة أخونا الكريم عبد العزيز (قلم الإكسيل) وقم بتغيير النسخة .. Sub ResetAll() Dim myCommandBar As CommandBar For Each myCommandBar In Application.CommandBars If myCommandBar.Type = msoBarTypePopup Then myCommandBar.Reset myCommandBar.Enabled = True End If Next myCommandBar End Sub

أخي الكريم محمد الزريعي يفضل دائماً أن يكون الملف معبر عن الطلب ..لما لم تضع الملف كما وصفت في مشاركتك السابقة بشكل مباشر .. عموماً يرجى الإطلاع على التوجيهات لمعرفة كيفية التعامل مع المنتدى إليك الكود التالي وإن شاء المولى يفي بالغرض Sub SortCustomList() Dim I As Long, LR As Long, vArray() As Variant vArray = Array("دكتور", "ماجستير", "بكالوريوس", "دبلوم", "ثانوية عامة") LR = Cells(Rows.Count, 1).End(xlUp).Row Application.AddCustomList vArray Range("A6:K" & LR).Sort Key1:=Range("G6:G" & LR), OrderCustom:=Application.CustomListCount + 1, Header:=xlYes Application.DeleteCustomList Application.CustomListCount End Sub Sort Custom List YasserKhalil.rar

برنامج المخزون و الفواتير الشامل .... الاصدار الثالث اكسيل 2007 - اكسيل 2010 اليوم بمشيئة الله هو الانطلاق الرسمى لهذة النسخه وبعد انتهاء مرحلة التجربة التى دامت اكثر من شهرين خطوات استخدام البرنامج لأول مره تسجيل البيانات الجديدة داخل البرنامج لعمل فواتير البيع و الشراء و الحركات المالية 1- تسجيل اسماء مناديب البيع وهى خطوه مهمه مطلوبة لتسجيل اسم عميل جديد 2- تسجيل و ادخال العملاء (يتم ربط كل عميل باسم مندوب) 3- تسجيل و ادخال الموردين 4- تسجيل و ادخال اسماء لفئة الصنف وهى خطوه مهمه مطلوبة لتسجيل صنف جديد 5- تسجيل و ادخال الاصناف (ولابد من وجود فئة مدخله مسبقا لكى تستطيع ادخال الصنف) 6- ولا تنسى تسجيل رصيد اول المده فى شاشة البيانات و الجرد الجديد فى هذا الاصدار * واجهة تطبيقية كاملة * برنامج كامل مخزون فواتير ذمم عملاء وموردين واستحقاقات خلال الفترات الزمنية المختلفة * اختصارات سريعة لتنفيذ العمليات و التقارير بسرعة عالية * كشف حساب بطريقة جديدة بمعنى نفترض انه هناك عميل ما علية مديونية بفيمة 15000 فالبرنامج يعطيك كشف حساب تفصيلى للمديونية المستحقة خلال فترات 30 يوم 60 يوم 90 يوم و اكثر من 90 يوم فمثلا فى المثال السابق يكون استحقاق المديونية على حسب فواتير العميل مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 و فى اكثر من 90 يوم 2000 فيكون اجمالى المديونية هم ال 15000 لكن الاستحقاق فى فترات مختلفه وهذا الكشف يفيد كل من يتعامل بالاجل لمعرفة المستحق خلال الفترة التى يريدها وعندما يقوم العميل بسداد جزء من المستحق يتم خصمه من المديونية القديمه بمعنى ان العميل فى المثال السابق قد قام بسداد 1500 فيتم خصمها من ال 2000 وهى مديونية الاكثر من 90 فيصبح كشف حسابة كالتالى مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 وفى اكثر من 90 يوم 1500 فيكون اجمالى المديونية هم ال 13500 * شاشة فواتير جديده تحوى الكثير و الكثير من الاختصارات للعملاء و الاصناف وتوصلك الى عدة تقارير بضغطة زر واحده عرض معلومات عن الصنف و رصيده الحالى داخل المستودع و اخر سعر شراء بمجرد اختيارك للصنف وادخاله داخلة الفاتوره سهولة الغاء وتعديل الصنف داخل الفاتورة عن طريق الدبل كليك ذهاب مباشره الى تقرير صنف معين بمجرد اختياره وضغط تقرير الصنف اكتشف المزيد............ *شاشة لتقرير المديونية خلال الفترات الزمنية المختلفة يجب عليك قراءة ومراجعة شرح البرنامج جيدا حيث توجد العديد و العديد من الاختصارات السريعة التي تنقلك من شاشة الى اخرى بسرعه عالية ولتوفير وقتك داخل البرنامج. كما توفر لك سرعة الحصول على المعلومة المطلوبة. * لتحميل نسخة من الشرح وهى عبارة عن ملف تنفيذي اضغط على الرابط التالى شرح برنامج المخزون و الفواتير الشامل( ملف تنفيذى... 6MB رابط خارجى على موقع ميديا فاير) * او الذهاب الى موضوع شرح البرنامج و مناقشات مشرفى و اعضاء المنتدى داخل المنتدى على الرابط التالى شرح برنامج المخزون و الفواتير الشامل(مشاركة داخل المنتدى) كما احببت ان اقدم مناقشة ونصائح مديري و اعضاء المنتدى للبرنامج لكى يستفيد منها الجميع وهذه المواضيع تم مناقشتها في موضوع شرح البرنامج داخل المنتدى انظر المشاركة التالية لمشاهدة النصائح و المناقشات حول البرنامج واخيرا اقدم لكم البرنامج حجم البرنامج 1.2 MB اختر اسم المستخدم المدير كلمة السر 123 محرر الاكواد 85211 لاتترد فى الاستفسار عن اى شيى داخل البرنامج ضع مشاركتك وسوف يتم الرد عليها كما يمكن مراسلتى على الايميل التالى amroomo@gmail.com اخيرا اتمنى ان يكون هذا البرنامج اضافة الى برامج المخزون و الفواتير وتغيير مسارها على الاكسيل فهذا العمل جديد بكل المقاييس فى افكاره التى اتمنى ان اكون قدمتها بصورة جيدة ويستقيد بها الجميع وَقُلْ رَبِّ زِدْنِي عِلْمًا ========================================================= المرفق المحدث الاخير: SIS 3.152 (Add City).rar

منقول 5 مواقع عليك أن تدمنها أكثر من فيسبوك وتويتر ! = = = = = = = = = = = = = = = = = = = 1- موقع تيد TED : تقريبا مش بيعدي يوم إلا ولازم أدخل علي تيد ، TED هي اخت...صار لـ : Technology تكنولوجيا - Entertainment ترفيه - Design تصميم. تيد عبارة عن مؤتمر أو قاعة محاضرات بيجيلها الناس من مختلف انحاء العالم ، والقي فيها محاضرات ناس مبدعين زي بيل جيتس (مؤسس شركة Microsoft)، بيل كلينتون، لاري بايج (مؤسس Google) وغيرهم كتير ،، الفكرة ان ted بـ يمنحهم 18 دقيقة كحد أقصى لإلقاء أفضل محاضرة في حياتهم .. وبتكون فعلا رائعة. اللينك ده فيه كل محاضرات الموقع مترجمة للغة العربية https://www.ted.com/talks/browse?language=ar محاضرة يوميا هتفرق كتير :)) 2- موقع Udacity او coursera الموقع ده من ضمن المواقع اللي بدفع اشتراك النت عشانها ، واحد من اشهر مواقع الكورسات الاونلاين علي النت ، هتلاقي عليه كورسات مجانية في كل المجالات واحيانا بتاخد شهادة بعد ما تخلص الكورس ، الموقع كنز لاي حد عايز يتعلم ، الكورسات بتكون باللغة الانجليزية ، فحاول تحسن من لغتك عشان تقدر تتفاعل مع كل محتويات الكورس وحلقات النقاش https://www.udacity.com/ . https://www.coursera.org/ 3- موقع رواق : اغلب المحتوي العلمي علي النت بيكون باللغة الانجليزية ، وده بيكون عائق امام بعض الناس اللي مستوي اللغة عندهم ضعيف . المحتوي العربي الفترة الاخيرة بدات تظهر فيه بعض المواقع المحترمة واللي مبذول فيها جهد رائع ، زي مثلا رواق رواق هي منصة بتقدم كورسات باللغة العربية في مختلف المجالات ، انا تابعت منهم 3 كورسات واستفدت جدا منهم ، الكورسات كلها مجانية والتسجيل فيها سهل جدا http://www.rwaq.org/ 4- موقع ويكي هاو " اسأل مجرب ولا تسأل حكيم " ،،، نفسك تعمل حاجة معينة ومش عارف الطريقة ، طريقة عمل المكرونة مثلا ؟ ، التزلج علي الجليد ؟ رسم ؟ ........... الخ " الموقع ده موسوعة عن كيفية عمل أي شيء، و لذلك جميع مقالات ويكي هاو تبدأ بـ “كيف” أو “How to" ما يقرب من 100 الف مقال في شتي مجالات الحياة ، والفيديو لا يتعدي الـ 10 دقائق ، يعني ممكن تسمعه وانت واقف في المترو الموقع متوفر ب 60 لغة .. كان منهم العربية لكن إنقطع المتطوعين العرب عن المشاركة! http://www.wikihow.com/Main-Page 5- موقع العلوم الحقيقية ، او الباحثون السوريون الموقعين رائعين ، بينشروا احدث ما وصل اليه العلم من ابحاث واكتشافات ومقالات مترجمة ، بالاضافة لمقالات في اغلب مجالات الحياة ( طب - رياضيات - اقتصاد - نفس - ........ ) تابعهم وهتستفاد جدا ان شاء الله http://real-sciences.com/ http://www.syr-res.com/ المواقع دي لو حضرتك تابعتها بشكل يومي ، مقدار العلم اللي ممكن تحصله منها يعادل العلم اللي اخدته في التعليم الحكومي ويزيد ، وكل اللي انت محتاجة ( كمبيوتر - نت - قلم وورقة - وحبة ارادة ) cpd

تفضل اخي كود اخي الغالي ابو البراء وياريت تحاول تتعلم السباحة :) 1.rar

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

شكرا حبيبي ابو البراء اذا اكنا مدرسة يبقي حضرتكم وزارة التربية والتعليم مدرسة وفن وابداع وسعت منك ياريس تقبل تحياتي

فى الـ Record Source للنموذج الفاتورة حضرتك كنت عامل استعلام وهذا ما قمت باضافته - جدول العملاء SELECT الفانورة.[رقم الفاتورة], الفانورة.[تاريخ الفاتورة], الفانورة.[إسم العميل], الفانورة.[نوع الزيارة], الفانورة.الفئة, الفانورة.[العلامة التجارية], الفانورة.[ترقيم المركبة], الفانورة.TTC, الفانورة.HT, الفانورة.TVA, الفانورة.TPF, الفانورة.TCT, الفانورة.TIMBER, الفانورة.صورة, العملاء.صورة FROM العملاء INNER JOIN ([العلامة التجارية] INNER JOIN الفانورة ON [العلامة التجارية].[رقم الصانع] = الفانورة.[العلامة التجارية]) ON العملاء.[رقم العميل] = الفانورة.[إسم العميل]; - صورة من جدول العملاء الى الاستعلام فأصبح بهذا الشكل ومن داخل الفورم قمت بتغيير الـ Control Source لصورة العملاء ليصبح العملاء.صورة

اشكرك وبارك الله فيك اخي شكرك وبارك الله فيك

مثال بسيط بعد التعديلات 2222.rar

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

شكرا اخي جعفر على هذا الملف الرائع وتظل المشكلة التى ذكرتها وهي اذا كان البحث عن 30 او 10 او 20 تأتي 300 او 100 او 200 3000 1000 2000 ياريت نلاقي لها حل ليكتمل العمل باذن الله مرفق نفس الملف للتسهيل على الاعضاء في تحميله وشكرا فلتر بقيمة خلية 2222.rar

جربوا الملف في الرابط أدناه https://app.box.com/s/8lzxirs3i6d8jpci9xe809az7odf5ngh

أخي الكريم بالنسبة للمصنف المسمى المنسوخ إليه والذي يحتوي المعادلات التي بها الروابط .. كيف تريد أن تكون شكل المعادلات ؟؟ هل تريد أن تكون المعادلات مرتبطة بأسماء أوراق العمل الجديدة name و old؟؟؟ عموماً جرب الكود التالي ليقوم باستبدال الروابط الموجودة بأوراق العمل الجديدة المطلوب عمل المعادلات على أساسها Sub ReplacementForLinks() With Cells .Replace "'*\[المنسوخ منه.xls]الاسم'!", "name!" .Replace "'*\[المنسوخ منه.xls]السن'!", "old!" End With End Sub أرجو أن يفي بالكود بالغرض تقبل تحياتي

اخي عبدالله الصاري مجهود رائع لقد قمت بالجزء الاصعب وتركت لنا اسهله جزاك الله كل الخير انا مجرد عملت تنسيق شرطي فقط الا اذا كان عند اخونا المسلم العربي اي تعديلات اخرى officena demande.rar

شكرا يا شباب على هذه الكلمات الجميلة جعفر

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

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

أخي الكريم قلم الإكسيل بارك الله فيك وجزيت خيراً على دعواتك الطيبة المباركة بالنسبة للكود ::: ------------------ أنا مجرب الكود بدل المرة ألف مرة لأني أستخدمه في برامجي الخاصة تأكد من أنك لم تحذف أي شيء من الكود أو الدالة المعرفة .. ضع الكود التالي بالكامل في موديول جديد ثم نفذ الأمر مرة أخرى Sub TestRun() Dim I As Integer For I = 2 To Cells(Rows.Count, "B").End(xlUp).Row If Kh_Names(Cells(I, "B"), 1) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) ElseIf Kh_Names(Cells(I, "B"), 1, 2) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "G") = Kh_Names(Cells(I, "B"), 2) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "G") = Kh_Names(Cells(I, "B"), 4) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4, 5) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "F") = Kh_Names(Cells(I, "B"), 4) Cells(I, "G") = Kh_Names(Cells(I, "B"), 5) End If Next I End Sub Function Kh_Names(FullName As String, ParamArray Index1()) As String Dim I As Integer Dim Kh_Split, MyArray, Arr 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 Arr In MyArray RE = Replace(Arr, " ", "^") SN = Replace(SN, Arr, 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 وهذه صورة من ورقة العمل بعد الضغط على الأمر Run ويمكن التأكد من عمل الكود من الأخوة الكرام الذين جربوا الملف الأخير تقبل تحياتي

تم معالجة الامر بجيث لا يظهر المكرر الا مرة واحدة و لا تحتسب الفراغات دالة بحث عن اسمsalim 1.rar

بعد اذن معلمى الحبيب الاستاذ الفاضل ابو خليل اجيب اخينا السائل الاستاذ او سيما شوف طريقة كتابة الكود لان حاولت انسخه هنا لكن العربى يظهر رموز غريبة لاتنسي نصيحة الاستاذ ابو خليل جزاه الله خيرا استخدم اللغة الانجليزية قدر الامكان حتى لا تواجه مشاكل فى التكويد ولا تترك فواصل بين الكلمات وان كان ولابد فلتكون _ محل المسافة بين اى مقطعين على سبيل المثال Awel_Maw3ed_llsyanah بدل من اول موعد للصيانه على كل حال انا لم اعدل فى المسميات ولكن فقط قمت بكتابة الكود بما يتناسب مع اللغة العربية 2النجاح.rar

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

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

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

الاخ رضا : اعمل استعلام حذف ويكون المعيار في الحقل الجديد الذي ذكرت هو صفر ثم شغل الاستعلام تلاحظ انه حذف كل السجلات التي لم يعلم عليها

السادة/ القائمين على إدارة الموقع المحترمين السادة/ أعضاء الموقع المحترمين ممكن توضيح كيف يمكن عمل كلمة مرور لجدول اكسيس ولكم جزيل الشكر

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

تفضل لعله المطلوب قاعدة التوجية العام.rar

أسف نسيت أنني أشتغل على نسخة الاكسيل باللغة الفرنسية و بالتالي ال Filter Box ShortCuts مختلفة عن الانجليزية المرجو القيام باستبدال كود الماكرو FilterRecords بالكود التالي (لاحظ التغيير باللون الأحمر) Public Sub FilterRecords(ByVal FilterRange As Range, ByVal InputCell As Range) On Error GoTo ErrHandler Set oInpuCell = InputCell If GetKeyState(VK_CAPSLOCK) = 1 Then SendKeys "{CAPSLOCK}", True Application.Goto FilterRange.Cells(1) Call SendMessage(GetDesktopWindow, WM_SETREDRAW, False, 0&) SendKeys "%{DOWN}" SendKeys "+{E}" SendKeys oInpuCell SetTimer Application.hwnd, 0, 1, AddressOf FilterNow Exit Sub ErrHandler: Call RefreshScreen End Sub الكود المعدل Public Sub FilterRecords(ByVal FilterRange As Range, ByVal InputCell As Range) On Error GoTo ErrHandler Set oInpuCell = InputCell If GetKeyState(VK_CAPSLOCK) = 1 Then SendKeys "{CAPSLOCK}", True Application.Goto FilterRange.Cells(1) Call SendMessage(GetDesktopWindow, WM_SETREDRAW, False, 0&) SendKeys "%{DOWN}" SendKeys "+{E}" SendKeys oInpuCell SetTimer Application.hwnd, 0, 1, AddressOf FilterNow Exit Sub ErrHandler: Call RefreshScreen End Sub باقي الكود يبقى كما هو

السلام عليكم في وقت ما ، اصبحت برامج المايكروسوفت اداة في ايدي المبرمجين المخربين ، واستغلّوا قدرة برامج المايكروسوفت على التحكم في الكمبيوتر عن طريق الـ VBA و Macro ، لذا ، اضطرت شركة مايكروسوفت الى القيام بإيقاف هذه البرامج عن طريق "مستوى أمان البرنامج" ، والطريقة التي تم الوصول لها للحماية ، اصبحت تتغير وتتحسن في اصدارات الاوفيس. اليك الطريقة الصحيحة في تمكين البرامج في استخدام VBA و Macro في الاصدار 2010: افتح برنامج الاكسس مباشرة ، وقم بإتباع الخطوات: بهذه الطريقة تستطيع ان تخبر الاكسس ان احد/بعض المجلدات هو امين/موثوق به ، وان اكسس يمكنه ان يفتح برامجك فيه وبدون رسالة الامان انا شخصيا لا اسمح لأي برنامج ان يغيّر اعدادات كمبيوتري ، واعتبره برنامج غير مرغوب فيه ، واحذفه على طول لذا ، اُفضل اتباع الخطوات اعلاه لأي كمبيوتر اتعامل معاه جعفر

سبب المشكلة ببساطة هو الطول الصفرى لحقل البيانات فعندما تسند القيمة "" قوسين خالين هذا سيؤدى لافراغ الحقل نعم ولكن ستتحول قيمته الى صفر والذى يعتبرها الحاسوب قيمة وليست خالية أى أن "" <> Null بلغة الحاسوب . هذا والله أعلم

السلام عليكم ورحمة الله في الملف المرفق تم وضع معادلة باستعمال الدالة SUMPRODUCT مع اعتبار فترة الإحصاء (بدايته ونهايته)... أرجو أن يكون المطلوب... بن علية احصاء.rar

جرب هذا الملف قائمة منسدلة salim.rar

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

الف الف مبروك للاساتذه الكرام أ / حسام عيسى أ / ياسر العربي أ / إبراهيم أبو ليلة ومن نجاح الى نجاح

السّلام عليكم و رحمة الله و بركاته ألف ألف مبروك للإخوة الأفاضل : حسام " الصّقر " ياسر العربي إبراهيم أبو ليله نتمنى لكم التوفيق والى الامام ثلاثتكم اعزاء علينا اخوكم سعد عابد

أخي الكريم محمد الزريعي اطلعت على الملف وما زال هناك مسافات زائدة في بعض الخلايا الخاصة بأسماء البنوك في ورقة التمويل .. عموماً إليك الحل التالي وإن شاء الله يفي بالغرض ويؤدي المطلوب جرب الكود وستجد أن بعض النتائج غير صحيحة بسبب أن هناك مسافة زائدة Sub CustomSort() Dim Sh As Worksheet, LR As Long Dim ws As Worksheet Set Sh = Sheets("التمويل") Set ws = Worksheets("h") LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row With Sh.Sort .SortFields.Clear .SortFields.Add Sh.Range("K3"), CustomOrder:=SortItems(ws.Range("R2:R13")) .SortFields.Add Sh.Range("R3"), CustomOrder:=SortItems(ws.Range("O2:O12")) .SortFields.Add Key:=Sh.Range("Q3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Sh.Range("A2:T" & LR) .Header = xlYes .Apply End With End Sub Function SortItems(rngSort As Range) As String Dim ArrSort() As Variant Dim I As Long ReDim ArrSort(1 To rngSort.Rows.Count) For I = 1 To UBound(ArrSort) ArrSort(I) = rngSort(I, 1) Next SortItems = Join(ArrSort, ",") End Function تقبل تحياتي الملف الاصلي بكامل الاكواد.rar

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

سادساً :- التعامل مع العناصر الموجوده داخل الــ Frame بطرق احترافيه فى البدايه يبدو ان العنوان غريب وغير مفهوم خليك معايا خطوه خطوه هتفم يعنى ايه الكلام ده شاهد الصوره التاليه دا فورم فى مرحلة التصميم وزى ما انتم شايفين يوجد زر اخضر اسمه Test وهو عباره عن Label ويوجد ايضا عدد 2 تكست بوكس وعدد 2 كمبو بوكس المطلوب انا عايز اعمل كود عند الضغط على الزر الاخضر اثناء عمل الفورم يقوم الكود بعمل اختبار للعناصراللى من النوع تكست بوكس هل هى فارغه ام بها بيانات اذا كانت فارغه يعطينى رساله باسم التكست وكمان يجعل لون التكست احمر ازاى ننفذ الكلام ده اولا هو عايز الكود يتم تنفيذه عند الضغط على الزر الاخضر حلو اوى طيب الزر الاخضر ده عباره عن ايه ؟ شوف الصوره هتلاقى ان الخاصيه Name هى Label1 اذن الكود هيكون كالتالى Private Sub Label1_Click() 'مكان وضع الكود المراد تنفيذه End Sub ما هو الكود المراد تنفيذه ؟ هو اختبار العناصر هل هى من النوع تكست بوكس أم لا واذا كانت من النوع تكست بوكس هل هى بها بيانات ام لا واذا تبين ان العنصر من نوع التكست بوكس ولا يوجد به بيانات اظهرلى رساله باسم العنصر وكمان اجعل العنصر لونه احمر أول شئ علشان اختبر كل العناصر اللى على الفورم واشوف نوعها اذن لازم اعرف متغير من نوع Control لان انا هتعامل مع العناصر Dim a As Control هنا سميت المتغير اسم a ( وطبعا يمكن تسمية اى اسم كيفا شئت ) وقلت اى المتغير a ده عباره عن عنصر تحكم ( قد يكون لليبل او تكست بوكس او كمبوبوكس او ليست بوكس او فريم او تشيك بوكس وغيرها من العناصر ) فعلشان الف على كل العناصر اللى موجوده على الفورم يبقى لازم الحلقه التكراريه For Each Private Sub Label1_Click() Dim a As Control For Each a In Me.Controls ' مكان اختبار العنصر اذا كان من النوع تكست بوكس وايضا هل هو فارغ من البيانات Next a End Sub عملت حلقه For Each للمتغير a وقلت ان a ده هو عباره عن عنصر تحكم موجود على الفورم Me.Controls Me هنا عايده على عناصر الفورم ازاى بقى اعمل اختبار للعناصر هل هى من النوع تكست بوكس و هل هى بها بيانات ام لا اذن هستخدم if Then If TypeOf a Is msForms.TextBox And a = "" Then End If if تعنى لو الاختبار الاول هل العنصر من نوع التكست بوكس TypeOf a Is msForms.TextBox TypeOf تعنى نوع الــ a هو عنصر التحكم اللى بيتغير كل مره مع الحلقه For Each is يكون msForms.TextBox تكست بوكس الاختبار الثانى a = "" and تعنى ( و ) لعمل شرط ثانى a = "" عنصر التحكم فارغ Then تعنى نفذ التالى ( وطبعا قفلنا if بــ End if ) طيب لما الكود يختبر نوع العنصر ويلاقيه تكست بوكس وكمان يلاقيه فارغ ماذا ينفذ يجعل التكست بوكس لون الخلفيه احمر ويظهر لى رساله باسم العنصر If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 MsgBox "فارغ يرجى تعبئة التكست" & a.Name End If شاهد الكود بشكله النهائى Private Sub Label1_Click() Dim a As Control For Each a In Me.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 MsgBox "فارغ يرجى تعبئة التكست" & a.Name End If Next a End Sub هعملك مشهد تمثيلى لعمل الكود جوا دراما يعنى جايز الاقى فيكم مخرج يكتشفنى عند عمل الكود فى اول سطر هيخزن فى ذاكرته ان المتغير a هو عنصر تحكم ثم ياتى للسطر الثانى وهو For Each a In Me.Controls الحلقه هتجعل ان a هى Label1 هيروح للسطر اللى بعده يعمل اختبار بالــ if فهيلاقى ان a اللى هى دلوقتى ( Label1) مش من النوع تكست بوكس اذن متحققش الشرط الاول فهينتقل الى End if بدون ما ينفذ اى شئ ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية لما يرجع للحلقه سيكون a فى هذه المره هى TextBox1 ثم ينتقل الى السطر التالى اختبار if طبعا هيختبر نوع TextBox1 هيلاقيه بالفعل من النوع TextBox تحقق اول شرط طيب هيشوف الشرط التانى هل التكست فارغ ام به بيانات اذا كان فارغ هيجعل لون خلفيته حمراء ويعطنى رساله باسمه ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية لما يرجع للحلقه سيكون a فى هذه المره هى ComboBox1 ثم ينتقل الى السطر التالى اختبار if طبعا هيختبر نوع ComboBox1 هيلاقيه مش من النوع ComboBox فلم يتحقق الشرط الاول فهينتقل الى End if بدون ما ينفذ اى شئ ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية وهكذا الى ان تنتهى الحلقه بعد ما تجعل a بكل العناصر اللى على الفورم وينتهى الكود شاهد هذه الصوره عند عمل الفورم والضغط على الزر الاخضر دى كانت مقدمه للمثال التالى وهو الاهم واللى اكيد هيقابلك لو انت هتصمم برامج اكيد هيقابلك المثال التالى مثال 2 :- شاهد الصوره التالية طبعا علشان اعمل كود فى حدث الليبل " الحفظ " هيكون الاعلان عن الكود كالتالى Private Sub Label1_Click() 'اولا اختبار صحة الادخالات 'ثانيا ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub انا موضوعى اليوم هو اولا اختبار صحة البيانات المدخله أما الجزء الخاص بترحيل البيانات الى الشيت مش موضوعى اليوم سنتناوله لاحقا باذن الله اولا اختبار صحة البيانات المدخله لو رجعت للصوره السابقه هتلاقى ان المطلوب اختبار كل عناصر التكست بوكس هل تم ملئ الدرجات بها ام لا وزى ما عرفنا قبل كدا ممكن تكون كالتالى Private Sub Label1_Click() If TextBox1 = "" Then TextBox1 .BackColor = 10200 End If If TextBox2 = "" Then TextBox2 .BackColor = 10200 End If End Sub يعنى هختبر كل عنصر بالشكل ده طبعا مستحيل طيب هتعمل ايه لو كان عندك مثلا 100 تكست بوكس او اكتر ؟؟؟؟؟؟ طبعا لو عملت كدا محتاج 100 صفحه علشان تكتب الكود مش منطق طبعا اذن لازم من حل احترافى شاهد الكود بشكل احترافى فى بضعه اسطر وبعدين نشرحه Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub الكود فى المثال السابق كانت حلقة For Each عباره عن For Each a In Me.Controls ( هنا كان المتغير a يمثل كل العناصر على الفورم لذالك استخدمت Me.Controls وقلت ان Me عائده على الفورم النشط لكن فى الكود الحالى انا عايز اتعامل مع العناصر اللى داخل الــ Frame1 فقط فتم كتابة الحلقه كالتالى عباره عن For Each a In Frame1.Controls فهنا a هتكون كل عنصر من العناصر اللى داخل الفريم فقط واحد صاحى معايا هيلاحظ ان لما استخدمت If لاختبار ان العنصر من النوع تكست بوكس تم استخدام شرط التحقق من نوع العنصر انه تكست بوكس وشرط ان العنصر فارغ فى سطر واحد من خلال And شاهد الكود If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If ولكن عند استخدام if لاختبار ان العنصر من النوع كمبوبوكس وان الاختيار تم من القائمه تم استخدام if لاختبار شرط التحقق من نوع العنصر اذا كان كمبوبوكس يتم تنفيذ if اخرى وكتابة الشرط الثانى ان الاختيار تم من القائمه شاهد الكود If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If فى حد عنده تفسير لذالك ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ ليه مكتبناش اختبار ان نوع العنصر كمبوبوكس وان الاختيار تم من القائمة فى سطر واحد من خلال And مثل التكست بوكس يعنى يكون كدا If TypeOf a Is msForms.ComboBox And a.MatchFound = False Then a.BackColor = 10200 End If هقولك انا ما هو السبب الحلقه For Each لما تشتغل هيكون اول مره a كل مره تمثل عنصر من عناصر التحكم داخل الفريم فهيكون أما ليبل أو تكست بوكس أو كمبوبوكس كما هو بمثالنا فى الصوره السابقه موضوع الشرح لما تشتغل If الاولى If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If فعندما يكون a عباره عن Label " " = a " " =Label1 فلا يوجد مشكله لان Label ممكن = فارغ -------------------------------------- فعندما يكون a عباره عن TextBox " " = a " " =TextBox1 فلا يوجد مشكله لان TextBoxممكن = فارغ -------------------------------------- فعندما يكون a عباره عن ComboBox " " = a " " =ComboBox1 فلا يوجد مشكله لان ComboBox ممكن = فارغ -------------------------------------- لما تشتغل If الثانيه If TypeOf a Is msForms.ComboBox And a.MatchFound = False Then a.BackColor = 10200 End If فعندما يكون a عباره عن Label a.MatchFound = False Label.MatchFound = False فهنا يوجد مشكله لان Label ليس من خواصه MatchFound وكذالك TextBox لان MatchFound هى من خواص ComboBox فقط وهى لعمل اختبار هل الاختيار تم من القائمه ام لا لذالك مينفعش نعمل الكود بالشكل ده هيحدث Error ولتجنب Error لازم يكون الكود بالشكل التالى If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If يعنى اختبر العنصر هل هو ComboBox أولا أم لا اذا كان من النوع ComboBox اعمل اختبار عليه وهو هل تم الاختيار من القائمه أم لا واذا كان العنصر من النوع Label أو TextBox متعملش اختبار MatchFound ارجوا ان يكون الشرح واضح هو بس محتاج تركيز شويه شاهد الكود مره تانية بشكله النهائى كالتالى Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ طبعا انت ممكن تغير فى الكود بدل ما ينفذ بجعل الخلفيه لونها احمر a.BackColor = 10200 ممكن تغير اى شئ تريد تنفيذه يعنى مثلا يعطى للمستخدم رساله باسم العنصر اللى فيه خطأ زى كدا Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then MsgBox a.Name & " برجاء تعبئة بيانات" End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then MsgBox a.Name & " برجاء تعبئة بيانات" End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ ------------------------------------------------------------------------------------------------------------------------------------ الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد انتظرونا تقبلوا تحياتى

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

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

اخواني تم التوصل الي الحل( والحمد الله ) سوف انشره لتعم الفائده للجميع لتسجيل الأداه قم بالضغط على start ثم اكتب cmd في مربع البحث عن البرامج وحينما يظهر سطر الأوامر اضغط بزر الفارة الأيمن عليه واختر Run as Administrator وبعدها شغل الأمر التالي فيه ثم اضغط انتر regsvr32 barcodex.ocx

اخى العزيز مشاركة الاستاذ / Adel.Hanafy ترد على تساؤلك وهذا الملف مرفق فى المشاركة حمايه.rar