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

السلام عليكم ورحمة الله وبركاته نبدأ بعون الله في شرح شيء جديد في عالم البرمجة ، وهو القاموس Dictionary ، وإن شاء المولى يكون مفيد لكم إخواني الكرام. طبعاً عنوان الموضوع جذبكم مش عشان البرمجة أكيد عشان الناموس (وإزاي نقدر نتخلص من الناموس والإزعاج اللي بيسببه ) .. الناموس هنا معناه القانون أو القاعدة .. ودا عنوان كعامل جذب مش أكتر ما هو القاموس Dictionary؟ ---------------------------- من اسمه ممكن نعرفه ..القاموس يعني تجميعة كلمات باللغة الإنجليزية وليها مرادف سواء بنفس اللغة أو بلغة أخرى .. اللي يهمنا في القاموس إني عبارة عن تجميعة Collection القاموس في لغة البرمجة عبارة عن تجميعة ، وبنستخدمه عشان نخزن فيه : أرقام - نصوص - تواريخ - مصفوفات نطاقات - كائنات - متغيرات .. والقاموس عبارة عن عناصر أو بنود Items وكل عنصر له مفتاح مميز Unique Key المفتاح دا فايدته ايه؟ من اسمه بردو نعرف إن المفتاح بيفتح لنا الباب .. بيفتح الباب للعنصر (عشان نتعامل معاه بشكل برمجي .. يعني المفتاح دليلنا أو مرشدنا للعنصر المطلوب التعامل معه) القاموس فايدته إننا بنقدر نتعامل مع البيانات في الذاكرة بعيداً عن ورقة العمل ..يعني مفيش تحديث للشاشة Screen Updating ، مفيش حساب تلقائي Auto Calculation ، بكدا نقدر نفول إنه أسرع في التعامل مع البيانات ++ (فائدة) بما إن القاموس بيحتوي على مفاتيح مميزة ، فيمكن استخدام الخاصية .Keys عشان نستخرج قائمة فريدة Unique List من البيانات ** القاموس ليس ضمن المكتبة القياسية للغة البرمجة VBA ، إنما هي جزء من Microsoft Scripting Runtime library ، وهذه المكتبة توجد في الملف الموجود في المسار التالي \Windows\system32\scrrun.DLL ولذلك إذا أردت استخدام القاموس فيمكنك من خلال محرر الأكواد الذهاب للقائمة Tools ثم References واختر المكتبة المسماة Microsoft Scripting Runtime library إنشاء القاموس Create Dictionary ----------------------------------- أبسط طريقة لإنشاء القاموس استخدام الأسطر التالية With CreateObject("scripting.Dictionary") End With ماذا تعني هذه الأسطر؟ تعني إنشاء كائن جديد بالاعتماد على المكتبة المسماة scripting.Dictionary ، وما بين السطرين سيتم كتابة أسطر وأوامر برمجية الأسطر التي ستبدأ بنقطة تعني التعامل مع خصائص الكائن أي أنها ستتعامل مع الكائن الجديد ## مثال بسيط لإضافة عنصر للقاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" End With الطريقة Method التي تلي النقطة تسمى Add أي أضف .. والمقصود منها إضافة عنصر جديد للقاموس .. ذكرنا في بداية الموضوع أن لكل عنصر مفتاح مميز ، المفتاح هنا First Name ، والعنصر يحتوي على النص Yasser يمكن استخدام متغير للقاموس بهذا الشكل Dim Dict As Object Set Dict = CreateObject("scripting.dictionary") With Dict .Add "First Name", "Yasser" End With الإعلان عن المتغير من النوع كائن ، ثم تعيين قيمة للمتغير ليساوي إنشاء الكائن من المكتبة الخاصة scripting.Dictionary ثم بدء التعامل مع الكائن القاموس .. ## مثال آخر : المثال التالي سيتناول عد العناصر داخل القاموس باستخدام الخاصية Count قم بوضع الكود داخل موديول ثم نفذ الكود ستجد رسالة بها عدد عناصر القاموس وهو في المثال 2 فقط مفتاح العنصر الأول هو First Name ومفتاح العنصر الثاني هو Second Name أما كلمة Yasser وكلمة Khalil فهي محتويات أو عناصر القاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" .Add "Last Name", "Khalil" MsgBox .Count End With وأكتفي بهذ الجزء البسيط .. لكي أجد المتابعة الجيدة منكم وإلى اللقاء في الأسبوع المقبل إن شاء الله مع حلقة جديدة في نفس الموضوع دمتم على طاعة الله

إخواني الكرام السلام عليكم ورحمة الله وبركاته أقدم لكم كود مع الشرح لاستخدام القاموس في استخراج القيم الفريدة أي الغير مكررة بفرض أن لديك قائمة أسماء في العمود الأول تبدأ من الخلية A2 .. وتريد استخراج القيم الفريدة أي الغير مكررة في النطاق .. أحد الحلول الجميلة هو استخدام القاموس لتخزين القيم الفريدة (بس يا ريت فريدة متزعلش) وإليكم الكود بالشرح Sub GetUniqueValues() 'يقوم الكود باستخراج القيم الفريدة أي الغير مكررة باستخدام الكائن قاموس '---------------------------------------------------------------------- 'المتغير الأول لتخزين قيم النطاق والمتغير الثاني لتخزين مفاتيح القاموس 'الثالث متغير للكائن القاموس والرابع متغير يستخدم في عمل حلقة تكرارية Dim myData As Variant, Temp As Variant Dim Obj As Object, I As Long 'ليساوي الكائن المسمى القاموس والذي يعتبر أداة قوية للتعامل مع القيم الفريدة [Obj] تعيين المتغير Set Obj = CreateObject("Scripting.Dictionary") 'ليساوي قيم النطاق في العمود الأول [myData] تعيين المتغير myData = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value 'حلقة تكرارية تبدأ من أول عنصر في مصفوفة القيم إلى آخر عنصر في المصفوفة For I = 1 To UBound(myData) 'هذا السطر هو أهم سطر في الكود حيث يتم تمرير القيمة للقاموس 'فيقوم القاموس بتخزينها إذا كانت القيمة تصادفه لأول مرة 'أما إذا كانت القيمة مكررة فلا يقوم بتخزينها مرة أخرى Obj(myData(I, 1) & "") = "" Next I 'ليساوي مفاتيح القاموس والتي تمثل القيم الغير مكررة [Temp] تعيين المتغير Temp = Obj.Keys 'حيث يتم تحديد عدد الصفوف [E1] وضع عناصر القاموس الغير مكررة في الخلية 'والتي تقوم بعد عناصر القاموس التي تم تخزينها [Count] من خلال كلمة 'عبارة عن مصفوفة بالقيم تكون على شكل أفقي لذا نستخدم [Temp] المتغير 'لتحويل القيم من الشكل الأفقي إلى الشكل الرأسي ليناسب وضع النتائج في عمود [Transpose] كلمة Range("E1").Resize(Obj.Count, 1) = Application.Transpose(Temp) End Sub لن يتم إرفاق ملف (عشان الكسالى ... يصحصحوا ويركزوا ) الموضوع بسيط مش محتاج مرفق افتح ملف إكسيل وضع قيم في النطاق A2:A20 مثلاً .. ضع أسماء مكررة في النطاق افتح محرر الأكواد ..أدرج موديول .. ضع الكود في الموديول روح لورقة العمل ونفذ الكود عن طريق Alt + F8 ... هتلاقي القيم الغير مكررة في النطاق من أول الخلية E1 .. وممكن تغير في الكود لتضع النتائج في أي خلية تريدها بس خلاااااااااااص ..وتصبحوا على السرير سالمين آمنين معافين تقبلوا تحياتي

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

الخطأ في كتابة اول الكود يوجد في اول الكود كما موضح بالصورة تكست بوكس 11 ولا يوجد بالفورم تكست بوكس11 من الاساس والمقصود هو تكست بوكس 1

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

وعليكم السلام تفضل الامر المسؤول عن ذلك ويمكنك استبدال الرابط الموجود داخل لسطر اما بمربع نص او متغير Call Shell("explorer " & "D:\officena\a1\b1\c1", vbNormalFocus)

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

يمكن ان يكون المطلوب مصنف الاستحقاق salim.rar

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

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

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

السلام عليكم مثال قديم للأستاذ أبو هاجر لاستخدام الماسح ( السكانر ) عن طريق الأكسس قمت على تحديثه وزيادة السيطرة واستبعاد تخزين مسار الصور حيث لا داعي لها . مرفق ملف مكتبة dll يجب نسخه في مجلد Windows\System . لا تنسونا من دعاكم . تحياتي . الملفات المرفقة Scanner.rar ( 471.28ك ) عدد مرات التنزيل: 38

اخوتي اعضاء المنتدى كما يعلم الجميع فإنه يتم الحكم على كفاءة اي برنامج من خلال مخرجاته أي تقاريره ومن يعمل في اكسس يلاحظ جمود تقاريره مقارنة بتقارير اكسل لذا فقد اخذت الكثير من الوقت في تصميم تقارير مرنة تشمل اهم الافكار المطلوبة في التقرير وكنت قد وضعتها في تقرير واحد بهدف رفعه للمنتدى ولكني رأيت ان ذلك يمكن ان يصعب على الأعضاء فهم الطريقة . لذا قررت ان اجعل المثال يحتوي على تقريرين . الأول : يوضح طريقة رسم الحدود وتحديد سجلات الصفحة والإقفال بعد آخر سجل . الثاني : يشمل جميع الأفكار . أرجو أن ينفع الله بهذا المثال كل طالب علم ... ملحوظة : المثال يحتوي على 80 سجل وتم تحديد عدد سجلات الصفحة 20 سجل لذا عند فتح التقرير سيطلب منك تحديد عدد السجلات المطلوبة لذا للتعرف على المثال بشكل واضح جرب تحديد عدد (5 و 20 و 21 و 40 و 45) على التوالي ولاحظ كيف سيظهر التقرير في كل مرة اسأل من الله الأجر والدعاء من كل من إستفاد من هذا العمل تحياتي,,, التقارير.rar

بسم الله و الحمد لله بعد اذن اخى / عبدالله باقشير بارك الله فيك و ابداعاتك _ و جزاك الله خيرا على علمك الفياض مرفق ملف خاص بالاستاذ/ عبدالله باقشير_kh_sumproduce و دليل حسابات اربعة مستويات ليستفيد به اعضاء المنتدى بعد التعديل بعد التعديل تابع ما تم تعديله على الملف بالرابط _ يومية و ميزان_kh_SumProduc_معدلG_2014 الجديد بالملف هو تكويد الحسابات عن طريق دليل الحسابات للاستاذ / عبدالله باقشير _ و لمتابعة طريقة التكويد بالدليل بالرابط _ دليل حسابات اربعة مستويات_KH و للاستفادة و المتابعة لخطوات التعديل على الملفين _ على الرابط _تكويد حسابات _ ليومية و ميزان_kh_sumproduc و لا تنسونا من صالح الدعاء _ و تقبلوا تحياتى يومية و ميزان_بدليل حسابات_kh_SumProduc_معدل_G_2014.rar

جرب هذا الملف Book1 books.rar

السلام عليكم تحية الى استاذنا ابو خليل ونستاذنه بالرد الاخ حسن لم تذكر ما عملت بالتفصيل نحتاج ان توضح بعض الامور 1 - هل قمت بعملية ربط الجداول بين القواعد الاماميه والقاعدة الخلفية 2 - لم تذكر نوع الشبكه وما هي الطريقة التي ترتبط الحواسيب مع بعضها بالتوفيق

اشكرك اخي حامد للاهتمام والرد بارك الله فيك حملت البرنامج وجربته وهو ممتاز تعرف على الغة العربية واظهرها سليمة عند تجربته واظهاره بقارئ الكيوار كود الخارجي ولكن لم استطع ان ادمجه في برنامج الاكسس ناهيك انه يمكن ادخال معلومه واحدة وليس معلومات متعددة كما هو الحال في المثال المرفق السابق . اعتقد ان المشكلة تتمثل في نوع الخط فالخط المستعمل في المثال وهو MW6 Matrix الذي لايدعم اللغة العربية بحث في عشرات المواقع عن خط يدعم اللغة العربية وعلى مدى اكثر من سنه ولكن لم اوفق ... الله المستعان شكرا لك مره اخرى اخي حامد

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

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

ضع هذا التنسيق General;[Red](General)

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

السلام عليكم شنو الرقم السري واسم المستخدم

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

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

أخي الفاضل محي الدين أبو البشر بارك الله فيك على مرورك العطر بالموضوع إليك التعديل البسيط ..تم وضع جملة IF لاختبار إذا ما كانت القيمة فراغ ام لا ..قبل تخزينها في القاموس Sub GetUniqueValues() Dim myData As Variant, Temp As Variant Dim Obj As Object, I As Long Set Obj = CreateObject("Scripting.Dictionary") myData = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value For I = 1 To UBound(myData) If Not IsEmpty(myData(I, 1)) Then Obj(myData(I, 1) & "") = "" End If Next I Temp = Obj.Keys Range("E1").Resize(Obj.Count, 1) = Application.Transpose(Temp) End Sub تقبل تحياتي

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

اخي الكريم الملف مصروب فيروس و قد رفض الجهاز فتحه لذا صممت لك ملفاً شبيهاً به مه كافة المعادلات اللازمة انظر الى المرفق صفحة 2 Ta'akhir.rar

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

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

السلام عليكم نضيف مربع نص وليكن text14 ونضيف عنده حدث ( عند التغيير ) Private Sub text14_Change() Dim ct As String * 1 Dim ss As String * 1 ct = """" ss = "*" Me.text14.Tag = Me.text14.Text Me.RecordSource = "SELECT * FROM S_Name WHERE sName LIKE " & ct & ss & (Nz(Me.text14.Tag)) & ss & ct & "" If Me.RecordsetClone.RecordCount = 0 Then Me.RecordSource = "" End If Me.text14 = Me.text14.Tag Me.text14.SetFocus SendKeys "{f2}" Me.Refresh End Sub حيث ان S_Name هو مصدر بيانات النموذج و sName حقل الاسم الموجود في النموذج الذي نبحث عنه

كفيت ووفيت اخوي بارك الله فيك هو المطلوب . جزاك الله الف خير

تفضل هذا تطبيق للفكرة التي ذكرتها اعلاه dty = DMax("edate", "employees") If Me.edate < dty Then Me.AllowEdits = False Me.fvacations.Locked = True Else Me.AllowEdits = True Me.fvacations.Locked = False End If db1.rar

عاجبك كدا أديني أخدت برد وعمال بعطس .. يا شماتة العربي فيا .. العربي مين؟؟! اخرس

أخي الحبيب محمد علي الطيب بارك الله فيك وجزاك الله كل خير على إحياء التراث والكنوز المدفونة إنه حقاً ملف رائع وجميل هل أثني على الملف والموضوع وأكتفي ؟؟! بالتأكيد لن يرتاح قلبي أبداً طالما لم أدلي بدلوي (قول مأثور من العربي) دعنا نحلل الملف بحيث يستفيد منه إخواننا الكرام في المنتدى (سيكون التحليل في نقاط) --------------------------------------------------------------------------------------------------- ** يعجبني دائماً أن تكون الجملة التالية في بداية كل موديول .. Option Explicit والتي من شأنها تجبر المبرمج على الإعلان عن المتغيرات وهو أمر مستحب وأنا عن نفسي أفضله ** تم الإعلان عن الـ API في بداية كل فورم بهذا الشكل Private Declare Function sndPlaySound Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _ ByVal uFlags As Long) As Long Dim MYPATH وتكرر نفس الإعلان في الفورم الثاني السؤال : لما التكرار .. ؟؟!!! هل فكرنا للحظة أنه يمكن الاستفادة من الإعلان بشكل عااااااااااااااام Public؟ ماذا لو أردت أن أضيف فورم أخرى وأريد فيها نفس الإعلان ..هل سيتحتم علي أن أقوم بالإعلان في كل فورم على حدا ..إنه لأمر مرهق !! ألستم توافقونني الرأي في تلك النقطة الحل : أن نقوم بالإعلان مرة واحدة فقط ..كيف سيتم ذلك؟ يتم ذلك في بداية أي موديول ونستخدم كلمة Public بدلاً من Private لأنه سيصبح إعلان عااااااااااااااااام وليس خاااااااااص بالفورم فقط كما يتم الإعلان عن المتغيرات المستخدمة في الموديول باستخدام كلمة Public أيضاً ليصبح الإعلان بهذا الشكل (يوضع في بداية الموديول) Public Declare Function sndPlaySound Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _ ByVal uFlags As Long) As Long Public MYPATH ولكن مهلاً ..ماذا عن أصحاب النطام المنتشر 64 بت ...حتماً ستواجههم مشكلة في العمل على الملف .. لابد أن نراعي جميع الأطراف .. المهم للتعديل ليصبح الكود يعمل على كلا النظامين 32 بت و 64 بت سيتم التعديل على الإعلان .. وإضافة المتغيرات الأخرى التي ستسبب أخطاء في حالة عدم الإعلان عنها #If VBA7 Then Public Declare PtrSafe Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long #Else Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long #End If Public myPath As String Public SoundFile, Result أخيراً انتهينا من تلك النقطة إليكم الملف المرفق بعد عمل التعديلات .. ليتناسب مع مستخدمي الـ 32 بت والـ 64 بت .. تقبلوا تحياتي Add Sound To CommandButton On UserForm.rar

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

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

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

السلام عليكم تفضل أخي جرب هذا التعديل حسب طلبك db1.rar

بصراحه الحل السريع اللى حضرنى الآن إن تاخد صورة الزرار الجديد كصوره وتضيفها على الزرار فى الوفيس 2007

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

جرب هذا الملف Talween.rar

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

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

و عليكم السلام و رحمة الله و بركاته ... 1- نعم تستطيع عمل برامج قوية ومنوعة و لا حصر لها . لكن اظن انه من ناحية الحماية توجد لغات برمجة و برامج افضل . 2- ممكن الاعتماد على معالجات البرنامج فقط . 3- نعم تستطيع رفع البرنامج على جهاز او على الشبكة . 4- ابدأ بالخطوات البسيطة و كلما واجهك استفسار تستطيع البحث عنه في المنتدى فان لم تجد الاجابة افتح موضوع جديد واشرح بشكل وافي مشكلتك و مرادك وبالنسبة للمعلمين فهنا ما اكثرهم و ما احلاهم من معلمين ... مع تمنياتي لك بالتوفيق الدائم ...

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

عسى ان يكون المطلوب جرب هذا الكزد Sub talween() ro = Cells(Rows.Count, "O").End(3).Row Range("a1:o" & ro).ClearFormats For Each cell In Range("o1:O" & ro) If IsNumeric(cell) And cell.Value < 0 Then cell.Offset(0, -14).Resize(1, 15).Interior.ColorIndex = 3 End If Next End Sub حاجة سهلة كل شيء بالكود متعلق بالحرف O استبدله الى M و استبدل الرقم 14- ب 12- و الرقم 15 ب 13 وأخيراً اين الاعجاب بالكود

المشكلة أخي الكريم في تصميم ملفك .. اتضح لي أنه لا يمكن الاعتماد على العمود السادس حيث أن البيانات المرحلة قد تكون فارغة في هذا العمود وهذا ما يحدث المشكلة... راعي أن موضوع دمج الخلايا يسبب المشاكل مع الاكواد عموماً جرب هذا الكود .. ولا تنسى أن تحدد أفضل إجابة Sub CutRow() Dim WS As Worksheet, SH As Worksheet, LR As Long, I As Long Dim Cell As Range Set WS = Sheets(" الخطة النظريةو التنفيذ الفعلي"): Set SH = Sheets("البنود المنتهية") Application.ScreenUpdating = False For Each Cell In WS.Range("N5:N" & WS.Cells(Rows.Count, 1).End(xlUp).Row) If Cell.Value >= 1 Then LR = IIf(SH.Cells(Rows.Count, 1).End(xlUp).Row <= 3, 4, SH.Cells(Rows.Count, 1).End(xlUp).Row + 1) Cell.EntireRow.Copy SH.Range("A" & LR) End If Next Cell For I = WS.Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1 If Cells(I, "N").Value >= 1 Then Cells(I, "N").EntireRow.Delete End If Next I Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

الأخ الكريم الوليد زين العابدين إليك الكود التالي عله يفي بالغرض Sub CutRow() Dim WS As Worksheet, SH As Worksheet, LR As Long, I As Long Dim Cell As Range Set WS = Sheets(" الخطة النظريةو التنفيذ الفعلي"): Set SH = Sheets("البنود المنتهية") Application.ScreenUpdating = False For Each Cell In WS.Range("N5:N" & WS.Cells(Rows.Count, 1).End(xlUp).Row) If Cell.Value >= 1 Then LR = IIf(SH.Cells(Rows.Count, 1).End(xlUp).Row <= 4, 4, SH.Cells(Rows.Count, 1).End(xlUp).Row + 1) Cell.EntireRow.Copy SH.Range("A" & LR) End If Next Cell For I = WS.Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1 If Cells(I, "N").Value >= 1 Then Cells(I, "N").EntireRow.Delete End If Next I Application.CutCopyMode = False Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة كما لا تنسى أن تضغط أعجبني هذا إذا أعجبك الحل وأدى الغرض تقبل تحياتي Cut Cell Entire Row To Another Sheet.rar

الله يبارك فيك , موضوع مفيد جدا يحتاجه الجميع بورك فيكم

السلام عليكم تم إضافة المرفق الى المشاركة لسهولة التحميل ================= عمل موفق وجهد جبار تم الاطلاع على اكواد الملف وارجو بعد إذنك ان تضع كلمة سر المحرر او ان تسمح لي بوضعها او رفعه مفتوح المصدر لان المنتدى هدفه الاول هو التعليم وليس الاحتكار 85