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

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

فنون وأساليب التنبؤ باستخدام الاكسيل نعرض أساليب التنبؤ بالدوال وأدوات تحليل البيانات الموجودة في برنامج ميكروسوفت اكسيل ثم نتناول الطرق الرياضية والاحصائية في كيفية حساب الدالة. للتأكيد على المزايا التي يوفرها الاكسيل والدقة العالية التي يحسب بها النتائج ******************************************** الفئات المستهدفة: المدراء الماليين رؤساء الحسابات المحاسبين مديري المبيعات المهتمين بدراسات الجدوى العاملون في مجال التخطيط المالي والموازنات التقديرية -------------------------------------------------------------------- دورة مجانية 100% يستضيفها جروب تدريب وتأهيل المحاسبين بالإسكندرية برعاية المحاسب القانوني الأستاذ احمد وفا. وسيتم تحديد موعد كل محاضره والاعلان عنها وسيكون الحضور اون لاين للانضمام في الدورة https://www.facebook.com/events/509996679169161/ ------------------------------------------------------ فيديو تعليمي بداخل الفيديو كتيب pdf+ ملفات اكسيل تطبيقية ارجو من الجميع المشاركة فهذه الدورة مجانية 100% ولا تنسونا بصالح دعاؤكم ملفات الاكسيل التطبيقية.rar

السلام عليكم ورحمة الله أخواني وأساتذتي الكرام لطالما أبدعتمونا بإنجازتكم وافكاركم الجميلة والمتميزة في هذا الموقع والصرح العملاق فأحببت أن أشارك معكم هذا الكود الجميل والمتميز في أطفاء وإعادة تشغيل الكمبيوتر من ملف أكسل وذلك بعد قمت ببعض التعديلات الخفيفة للملف لكي يصبح بشكل أجمل ومرغوب للجميع الملف يعمل على أنظمة ويندوز XP و7 و8 و8.1 وكافة نسخ أوفيس سواء كانت بيئة 32 بت أو 64 بت أترككم لتجربة الملف وإعطاء أفكار جديدة حول الموضوع تقبلو تحياتي ومروري إطفاء وإعادة تشغيل الكمبيوتر.rar

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

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

اخي ووالدي واستاذي اتمنى من الله دوام الصحة لك ولكل احبابك مجرد مرورك فقط اخي الغالي علي موضوعنا فهو لشرف عظيم لنا واتمنى من الله ان يفرج عنك ما انت فيه من ضيق وارجو منك الا تحرمنا من كلماتك الجميلة التي هي بدورها قادرة علي رفع الروح المعنوية لنا جميعا وعشان محدش يقول اني بخيل اادي الصور في فورم لللي محتاجه الموضوع دا بكود بسيط تقدر تضيف كل لمساتك عليه الكود يوضع في حدث تغيير الكومبوكس Private Sub ComboBox1_Change() On Error Resume Next TextBox1.Text = ComboBox1.Value MyPath = ThisWorkbook.Path & "\data\" FullImagePath = MyPath + TextBox1.Value Image1.Picture = LoadPicture(FullImagePath) End Sub image & userform.rar

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

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

خسارة ..جيت متأخر يا عربي خدها الصقر وطار

بسم الله الرّحمن الرحيم و أنا أسعد أنّي أكون ثاني المهنّئين .. مباشرة بعد أستاذنا القدير المحترم " الصّقر " .. ألف مبروك أستاذنا العزيز ياسر العربي و عقبال الأعلى .. فالأعلى إن شاء الله .. فائق إحتراماتي

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

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

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

حلول ممتازة اساتذتى الكرام .... جزاكم الله خيراً واسمحوا لى بتقديم احد الحلول الاخرى إثراءاً للموضوع يوم المراقبة =INDEX(ورقة2!D7:D11;SMALL(IF(ورقة2!E7:G11=L8;ROW(ورقة2!E7:G11)-ROW(ورقة2!E7)+1);1)) مكان المراقبة =INDEX(ورقة2!E6:G6;SMALL(IF(ورقة2!E7:G11=L8;COLUMN(ورقة2!E7:G11)-COLUMN(ورقة2!E7)+1);1)) هذه معادلات صفيف بعد كتابتها يتم الضغط على CTRL+SHIFT+ENTER وليس ENTER فقط واليك المرفق ايام المراقبة.rar

السلام عليكم أخي محمد الخازمي الكود هذا هو اظهار الرقم التسلسلي الحقيقي الذي لايتغير للقرص الصلب في جهاز الكمبيوتر في الورك بوك في الخلية(e5) يكون الايدي بتاع القرص الصلب وبعدها عند فتح الملف يتم بحث الايدي اذا كان مطابق يظل البرنامج مفتوح وإذا غير مطابق يعطيك رسالة خطأ من خلال فهمي للمقصود هو تريد حماية للملف من النقل بحيث يعمل ويشتغل على جهاز واحد إذا كان هذا طلبك فيرجى مراجعة الملف المرفق فيه أسهل اساليب الحماية وهي إظهار الرقم التسلسلي للوحة الام (motherboard) في جهاز الكمبيوتر قم بفتح الملف وبعدها قم بفتحه مرة أخرى على جهاز كمبيوتر أخر سوف يغلق تلقائياً نظراً لعدم التطابق أتمنى أن أكون قد فهمت المقصود من طلبك تقبل مروري وتحياتي get motherboard in excel.rar

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

وجزيت خيراً بمثل ما دعوت

تمت الإجابة في الموضوع الخاص بهذه النقطة تقبل تحياتي

السلام عليكم عدنا أخيرا بعد غياب طال قليلا بسبب ظروف العمل سأكمل انشاء الله من حيث توقفت 1- بدات بفاتورة الادخال وتم تصميمها كاملة إن شاء الله لاحظوا اخواني القيم الافتراضية التي تأخذها الفاتورة في التاريخ وفي المسلم وأمر العمل يقوم البرنامج بإعتبار اخر سجل هو السجل افتراضي للسجل الجديد وذلك باستخدام الدالة DLast 2- استخدمت استعلام توحيد حتى احصل على الوحدات تحت بعضها في جسم الفاتورة واساس استعلام التوحيد العبارة التالية " union all " هي تقوم بجمع الجداول او الاعمدة من نفس الجدول لكن لا تنسى شيء مهم وهو انه يجب ان يكون عدد الاعمدة نفسه حتى يكتمل الاستعلام accurate 16.rar

الله يكرمك ويعزك اخى وحبيبي واستاذى حسام عيسى اتمنى ان يفيدك ويفيد الجميع

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

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

الاستاذ ياسر ابو البراء اشكركم على المجهود الكبير وسعة صدركم العمل رائع جزاكم الله خيرا تحياتي لكم واحترامي

السلام عليكم اللأخ سمير لقد عدلت وأضفت بعض الأشياء حسب فهمي وأرجو أني وفقت للمطلوب وهذا هو المرفق: sc_2.rar

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

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

السّلام عليكم و رحمة الله و بركاته أخي الكريم ياسر العربي .. فكّرت أهديلك إيهْ في حفلة تخرّجك .. لمْ أجدْ سوى هذه .. أرجو أن تكون هديّتي قد المقام أخوك / عبد العزيز البسكري ياسر العربي.rar

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

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

اخي العزيز السلام عليكم اي حقل يمثل عدد ايام الغياب للمادة

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

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

بعد اذن اخي الحبيب ابو البراء اضع بين ايديكم البداية لطريق البرمجة طبعا للاخ العزيز ابو البراء http://www.officena.net/ib/topic/56941-افتح-الباب-وادخل-لعالم-البرمجة-متخافوش-يا-أحباب-من-اللي-ورا-الباب/ وبعدين تدخل علي قسم اكواد vba http://www.officena.net/ib/forum/51-قسم-أكواد-فيجوال-بيزيك-التطبيقات-vba/ وبعدين تدور علي الامثلة وتعمل زيها كدا وتحاول تجيب امثلة مختلفة وتربطهم وتعمل منهم برامج مختلفة وزي ما نصحنا اخواتنا هنا لا تيأس لا تيأس واليك كلمات الاستاذ الغالي ابو البراء لي منذ فترة هذا الموضوع يكثر فيه الحديث ولكن خلاصة القول ..أنك ما دمت نويت التعلم فستظل في رحلة تعلم مستمرة لا تنتهي عند حد معين فعندما التحقت بالمنتدى في بداية معرفتي بالإكسيل .. كنت أجد الأكواد ألغاز صعبة الفهم لدرجة أنني اعتقدت أن من يكتب الكود ليس من البشر وفي الحقيقة أن التدرب والاستمرارية والمتابعة الجيدة والإطلاع على الكتب والمنتديات الأخرى إلى آخر تلك الطرق للتعلم ستوصلك إلى نتيجة مرضية في النهاية لقد تمرست في المجال من سنوات وإلى اليوم أتعلم كل يوم ما هو جديد في هذا العالم .. ولا مانع على الإطلاق الاستفادة من الأكواد التي يقدمها الآخرون ..بالعكس هذا ما يجب عليك الاقتداء به ، اعمل بالحكمة التي تقول : ابدأ من حيث انتهى الآخرون قم بدراسة الأساسيات في هذا العلم أولاً بشكل جيد حتى إذا تمكنت من الأساسيات انتقل للتعامل الفعلي مع الأكواد وبداية كتابة الكود وعند مرحلة التأليف لا تيأس . لا تيأس .. لا تيأس .. فالفشل سيكون قرينك دائماًَ والفشل ليس بعيب إنما هو دافع للتعلم أكثر والمحاولة أكثر واجعل شعارك : حاول وافشل ثم حاول وافشل ثم كرر المحاولة مئات المرات إذا تطلب الأمر وافشل مئات المرات ، ولا تيأس أبداً .. لابد أنك ستصل إلى بغيتك يوماً ما تقبل مروري المتواضع ياسر العربي

مبروك ومليون مبروك اخى خالد انت لها اهل اسال الله ان يعنيك ويوفقك الى ما فيه الخير لاخوانك بالمنتدى تقبل تحياتى

ايه الحلاوه دى يا محترف ايوه كدا طلع كنــــــــــــــــــــــوزك (اوعى تقراها بدون حرف النون ) جزاكم الله خيرا لمشاركتنا اعمالك القيمة تقبل تحياتى

افكار حلوة والله من الاستاذين علي وابا خليل الاستاذ ابا خليل حسن فكرة الاستاذ علي وبوجود مفتاح الحل وهو الطرح ثم الزيادة ! تحسين رائع ! هنا اخينا حربي العنزي ذكر : فهل الفاصلة فاصلة عشرية ؟ لانه ذكر النتاج 819 ! ولم يذكر 819000 وهو الناتج في الحلين من قبل الاساتذه اذا اعتبرنا الرقم بدون فاصلة ! واذا بفاصلة يظهر رقما اخر ! وهذا مجرد تحويل فكرة الاستاذين الى تعبير في مربع نص : =IIf([Summuny] Mod 250>0;([Summuny]-([Summuny] Mod 250))+250;[Summuny]) تحياتي

السلام عليكم ورحمة الله وبركاته أساتذتى واخوتى اليوم أقدم لكم كودا منقولا بعد تعديله وترجمته لتحديد الفترة التجريبية لملف اكسل . فكرة الكود : عند فتح الملف يتم انشاء ملف نصى دون شعور المستخدم يتم تحرير تاريخ ووقت بداية فتح الملف فى الملف النصى بقورمات معين كما يظهر فى الكود بعد ذلك يقارن اكسل تاريخ اليوم مع التاريخ المحرر فى الملف النصى حتى تنتهى أيام الفترة التجريبية فاذا انتهت الفترة التجريبية يتم الآتى : 1 - اغلاق ملف الاكسل و عدم قدرتك على فتحه 2 - انشاء مجلد جديد تجد فيه : ملف نصى نشكرك فيه على تجربة المنتج وأوراق العمل فى الملف الأصلى تحفظ لك كل على حدة فى ملف مستقل الكود وعليه الشرح : Option Explicit Private Sub Workbook_Open() Dim StartTime#, CurrentTime# '---------------------------------------------------------- ' اعداد الفترة التجريبية كالتالى ' Integers 1, 2, 3,30 ,365 ...etc = number of days use ' 1/24 = 1hour , 1/48 = 30Mins , 1/144 = 10Mins use Const TrialPeriod# = 30 ' 30 days trial '---------------------------------------------------------- 'انشاء ملف مبهم المسار والاسم لتحديد بداية الفترة التجريبية Const ObscurePath = "C:\" Const ObscureFile = "Test File Log.Log" 'اذا كان الملف ذو المسار والاسم المحدد فارغا فان If Dir(ObscurePath & ObscureFile) = Empty Then ' بداية الوقت = تاريخ اليوم والوقت الحالى بالتنسيق الخاص StartTime = Format(Now, "#0.#########0") 'جواب الشرط : افتح الملف ذو المسار والاسم المحدد Open ObscurePath & ObscureFile For Output As #1 'تابع جواب الشرط : اكتب فى الملف بداية الوقت Print #1, StartTime Else ' فى حالة عدم تحقق الشرط فان 'افتح الملف ذو المسار والاسم للتحقق من وقت البداية Open ObscurePath & ObscureFile For Input As #1 Input #1, StartTime ' الوقت الحالى = تاريخ اليوم والوقت الحالى بالتنسيق الخاص CurrentTime = Format(Now, "#0.#########0") 'اذا كان الوقت الحالى أقل من بداية الوقت + الفترة التجريبية If CurrentTime < StartTime + TrialPeriod Then Close #1 ' غلق الملف المبهم قيد الاستعمال Exit Sub ' الخروج من الاجراء Else ' فى حالة عدم تحقق الشرط If [A1] <> "Expired" Then ' اذا كانت الخلية لا تساوى النص "Expired" فان ' رسالة للمستخدم بانتهاء الفترة التجريبية وعدم صلاحية الملف للاستعمال MsgBox "Sorry, your trial period has expired " & vbLf & _ "your data will now be extracted and saved for you..." & vbLf & "" & vbLf & _ "This workbook will then be made unusable." Close #1 ' غلق الملف المبهم قيد الاستعمال SaveShtsAsBook ' استدعاء كود حفظ البيانات للمستخدم [A1] = "Expired" ActiveWorkbook.Save ' حفظ الملف Application.Quit ' اغلاق اكسل نهائيا ElseIf [A1] = "Expired" Then ' اذا كانت الخلية تساوى النص "Expired" فان Close #1 ' غلق الملف المبهم قيد الاستعمال Application.Quit ' اغلاق اكسل نهائيا End If End If End If Close #1 End Sub Sub SaveShtsAsBook() ' كود حفظ بيانات المستخدم بحيث كل شيت يحفظ فى ملف منفصل Dim MyFilePath As String, Sheet As Worksheet, SheetName As String, N As Integer MyFilePath = ActiveWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) With Application .ScreenUpdating = False ' ايقاف تحديث الشاشة .DisplayAlerts = False ' ايقاف التنبيهات On Error Resume Next ' فى حالة الخطأ تجاهله MkDir MyFilePath ' انشاء مجلد فارغ باسم الملف For N = 1 To Sheets.Count ' حلقة تكرارية بعدد أوراق الملف Sheets(N).Activate ' تنشيط الشيت SheetName = ActiveSheet.Name ' اعتبار المتغير = اسم الشيت Cells.Copy ' نسخ كامل الشيت Workbooks.Add (xlWBATWorksheet) ' انشاء ملف اكسل جديد With ActiveWorkbook ' مع الملف النشط With .ActiveSheet ' مع الشيت النشط .Paste ' لصق البيانات فيه .Name = SheetName ' تسمية الشيت النشط [A1].Select ' تنشيط الخلية End With ' حفظ الملف النشط فى المجلد باسم الشيت النشط .SaveAs FileName:=MyFilePath & "\" & SheetName & ".xls" ' غلق الملف النشط مع حفظ البيانات .Close SaveChanges:=True End With .CutCopyMode = False ' تفريغ الذاكرة العشوائية Next ' الشيت التالى End With ' انشاء ملف نصى به تعليمات هامة للمستخدم بداخل المجلد Open MyFilePath & "\Read Me.log" For Output As #1 ' كتابة الأسطر التالية فى الملف النصى Print #1, "Thank you for trying out this product." Print #1, "If it meets your Requirements, visit :" Print #1, "http://www.officena.com " Print #1, "to purchase the full version..." Print #1, "" Print #1, " --------- Regards -------------" Print #1, "Mokhtar Hussien officena team" Close #1 ' غلق الملف النصى End Sub الكود يوضع فى حدث Workbook بامكانك تعديل مسار الملف النصى وبامكانك تعديل الفترة التجريبية الى مدة زمنية محددة أو شهور أو سنوات كما يتضح فى التعليق المحرر فى الكود لتجربة الكود : اذهب الى الملف النصى ستجد رقما زى كده : 42298.7085185185 ده هو وقت تشغيل الملف نقص الفترة التجريبية المحددة فى الكود من الرقم الصحيح 42298. يعنى نخلية 42250 مثلا ونحفظ الملف النصى على كدة روح افتح الملف هتلاقى الملف يقلك لا شكرا على كده وهحفظلك بياناتك عشان متزعلش مرفق للتجربة : Trial Version Ended 30 days.rar

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

جزاك الله خيرا استاذ علي .. سبقتني .. فكرة جميلة احتساب اخر 3 ارقام وهذه فكرة اخرى .. ويمكن توظيفها داخل الاستعلام .. اتمنى تنال استحسانكم : Public Function Rondx(Ron As Double) As Double Dim v1, v2 As Double v2 = Ron Mod 250 If v2 > 0 Then v1 = (Ron - v2) + 250 Else v1 = Ron End If Rondx = v1 End Function Private Sub Form_Current() Me.Summuny2 = Rondx(Nz([Summuny])) End Sub

السلام عليكم جميعا ورحمته الله وبركاته أخى الفاضل الاستاذ // رضا راغب أهلا وسهلا بك أخى الكريم بين إخوانك المتميزين خلقا وعلما وأدبا وبعد إذن اخى الحبيب // ياسر خليل " أبو البراء " وإثراءا للموضوع إليك هذا الكود وبإذن الله تعالى ستجد حلا للموضوع جزاكم الله خيرا وبارك فيكم Private Const cRunWhat = "Tarhil_Values" Private RunWhen As Double, Arr() As Range, CurIndex As Long Public Sub StartTimer() Dim A As Areas, I As Long If RunWhen > 0 Then MsgBox "The Process Is Already Running" Exit Sub End If Set A = Sheets("Sheet1").Columns("A").SpecialCells(2, 1).Areas ReDim Arr(1 To A.Count) For I = 1 To A.Count Set Arr(I) = A(I).CurrentRegion Next I CurIndex = 0 RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub Public Sub StopTimer() On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=False RunWhen = -1 MsgBox "Transferring Data Will Be Turned Off" End Sub Private Sub Tarhil_Values() CurIndex = CurIndex + 1 If CurIndex > UBound(Arr) Then StopTimer Exit Sub End If Arr(CurIndex).Copy Sheets("Sheet2").Cells(Arr(CurIndex).Row, "C") Application.CutCopyMode = False RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub

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

أخي الكريم جرب الملف المرفق التالي ** الكود مقسم إلى كود يوضع في موديول عادي Public Arr, ArrOut Sub RefreshArray() Dim WS As Worksheet, ArrTemp, I As Long, P As Long ReDim Arr(1, 0) For Each WS In Sheets If WS.Name <> "البحث" And WS.Name <> "تصفية البيانات المكررة " And WS.Name <> "بيانات ثانوية" Then If WS.Cells(Rows.Count, "G").End(xlUp).Row > 1 Then ArrTemp = WS.Range("A1").CurrentRegion.Columns("G").Value I = UBound(Arr, 2) + UBound(ArrTemp, 1) ReDim Preserve Arr(1, I) For I = 2 To UBound(ArrTemp, 1) If Len(ArrTemp(I, 1)) Then Arr(0, P) = ArrTemp(I, 1) Arr(1, P) = WS.Name & "/" & I P = P + 1 End If Next I End If End If Next WS ReDim Preserve Arr(1, P - 1) End Sub Sub GetSearchResult(Param As String) Dim LastRow As Long, I As Long, P As Long If Not IsArray(Arr) Then RefreshArray ReDim ArrOut(1, UBound(Arr, 2)) With Sheets("البحث") LastRow = Application.Max(.Cells(.Rows.Count, "E").End(xlUp).Row, 3) .Range("E3:E" & LastRow).ClearContents P = 0 For I = LBound(Arr, 2) To UBound(Arr, 2) If InStr(1, Arr(0, I), Param, vbTextCompare) Then ArrOut(0, P) = Arr(0, I) ArrOut(1, P) = Arr(1, I) P = P + 1 End If Next I If P > 0 And Param <> "" Then ReDim Preserve ArrOut(1, P - 1) .Range("E3").Resize(UBound(ArrOut, 2) + 1, 1).Value = Application.Transpose(ArrOut) Else .Range("B2:B26,D2:D26").ClearContents End If End With End Sub Sub RefreshList(Param As Long) Dim Arr, ArrOut1(1 To 25, 1 To 1), ArrOut2(1 To 25, 1 To 1), I As Long With Sheets("البحث") .Range("B2:B26,D2:D26").ClearContents On Error Resume Next Arr = Sheets(Split(ArrOut(1, Param - 3), "/")(0)).Rows(Val(Split(ArrOut(1, Param - 3), "/")(1))).Resize(, 56).Value If Err.Number <> 0 Then Exit Sub On Error GoTo 0 ArrOut1(1, 1) = Arr(1, 9) For I = 2 To 25 ArrOut1(I, 1) = Arr(1, I + 5) Next I For I = 1 To 25 ArrOut2(I, 1) = Arr(1, I + 31) Next I .Range("B2").Resize(UBound(ArrOut1, 1), UBound(ArrOut1, 2)).Value = ArrOut1 .Range("D2").Resize(UBound(ArrOut2, 1), UBound(ArrOut2, 2)).Value = ArrOut2 End With End Sub والجزء الثاني يوضع في حدث ورقة العمل المسماة "البحث" Private Sub TextBox1_Change() GetSearchResult TextBox1.Text End Sub Private Sub Worksheet_Activate() RefreshArray End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Columns("E")) Is Nothing Then If Target.Row >= 3 And Target.Count = 1 Then If Len(Target.Value) Then RefreshList Target.Row End If End If End Sub أرجو أن يكون المطلوب ويعالج مشكلة البطء لديك إن شاء الله تقبل تحياتي Textbox Search All Sheets YasserKhalil.rar

شرح اكثر من مبهر - زادك الله بسطة في العلم وسعة في الرزق - جزاك الله كل خير

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

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

أخي وحبيبي في الله أبو يوسف لا أعرف من هو (لوزتين بدخل) .. ولكن يبدو أن عقلي أيضاً مثل عقله بالنسبة لمشكلة الانترنت أقترح استخدام الإضافة المرفقة في المشاركة ... قم بتحميل الإضافة المسماة Mozilla Archiver Format ثم فك الضغط عنها لتجد الملف المسمى Mozilla Archiver Format.xpi من خلال الفايرفوكس روح على قايمة Tools ثم اختر الأمر Add-ons ستجد علامة تشبه الترس وبجانبها سهم .. على أنها قائمة منسدلة اختر الأمر Install Add-on from File ، ستظهر لك نافذة تحدد من خلالها مكان الإضافة التي لها الامتداد xpi ، ثم تظهر رسالة فيها أمرين أحدهما Install لتأكيد تنصيب الإضافة والأخرى Cancel لإلغاء الأمر قم بإغلاق الفايرفوكس ثم أعد فتحه افتح أي موضوع من موضوعات المنتدى التي تريد حفظها لتصفحها في وقتٍ لاحق .. ومن خلال قائمة File في المتصفح الفايرفوكس ستجد الأمر المسمى Save Page In Archive As ستفتح لك نافذة الحفظ التي تسمي فيها الملف الأرشيف وتحدد مكانه .. يمكنك تصفح الصفحة وكأنك داخل انترنت بالضبط جرب الإضافة ولا تنساني من دعائك تقبل تحياتي Mozilla Archiver Format.rar

السلام عليكم ورحمة الله وبركاته كيف حالكم إخواني الكرام في المنتدى الغالي؟ لقيت نفسي نفسي (نفسي الأولى غير التانية ..) نفسي الأولى يعني أنا - وأعوذ بالله من كلمة أنا - ، ونفسي التانية يعني حاجة أتمنى أعملها .. المهم لقيت نفسي أعمل حاجة مختلفة .. بشكل مختلف .. بأسلوب مختلف يكون فيه عنصر التشويق والإثارة والبساطة مجتمعين في نفس الوقت. كتير مننا أول ما يسمع كلمة البرمجة والأكواد يتخض وكأن الموضوع مستحيل ...أبدا كل الحكاية إننا بنبدأ غلط مش بناخد الخطوات الصحيحة لتعلم البرمجة. لو عايز تتعلم البرمجة ونفسك بجد تبدأ تتمكن فيها خليك معايا ، هنقضيها رغي شوية وهزار شويتين ، وجد مش كتير ... ايه رأيكم؟ نبدأ على بركة الله .. أول حاجة بعد ما تنصب الأوفيس وتفتح الإكسيل تلاقي اللي انت عايزه مش موجود طيب نظهره إزاي ؟؟ ببساطة فيه زر أوفيس فوق شمال هتضغط عليه وتضغط Excel Options هتلاقي نافذة فيها خيار اسمه Show Developer tab in the Ribbon يعني إظهار التبويب ، وهتلاقي جنبه مربع تحط فيه علامة صح مبروك الخطوة الأولى واحد هيقولي عندك اقف أول خطوة فشلت فيها ..هقوله ربنا ما يحرمنا من الفشل لأن الفشل أول طريق النجاح .. هقولك لو ملقتش اللي بحكي عليه يبقا اصدار الأوفيس مختلف أنا شغال على 2007 ، وحضرتك على 2010 أو 2013 (بالنسبة ل 2003 والله ما أنا معبره كفاية عليه لحد كدا) ... بالنسبة لـ 2010 و 2013 بيكون من قائمة File ثم Options ثم من القايمة الشمال فيه Customize Ribbon وفي الناحية اليمين هتلاقي قائمة بالتبويبات وجنب كل تبويب علامة صح اللي يعجبك علم عليه صح واللي ميعجبكش ارميه في الزبالة... المهم هتلاقي التبويب اللي هيفتح لنا الباب لعالم البرمجة .. دا كان المفتاح للدخول نخش لتاني حاجة المفتاح عشان يفتح معاك لازم تحط عليه شوية زيت ، يعني لازم تضبط إعدادات الماكرو عشان الأكواد تشتغل معاك تمام من التبويب الجديد انقر على Macor Security هيفتح معاك نافذة بتختار منها آخر خيار Enable all macros وبتعلم علامة صح على الخيار اللي جنبه مربع Trust access to VBA الحمد لله خلصنا من النقطة الأولى والتانية ... ننتقل لنقطة جديدة : هيظهر التبويب في الآخر .. جمد قلبك واشرب ديو وافتح الباب لمحرر الأكواد اضغط على Visual Basic من التبويب المذكور أو لو بتحب تتعامل مع الكيبورد اضغط Alt + F11 كدا الباب الحمد لله فتح .. لو أول مرة تدخل على محرر الأكواد متتخضش واحدة واحدة هبندا نتعلم كل اللي موجود .. المهم محدش يستعجلني عشان أنا مستعجل النافذة دي اسمها نافذة المشروع Project window يعني الإكسيل بيتعامل مع المصنف إنه مشروع .. والمشروع مكون من 3 شيتات اللي بنسميهم أوراق العمل Sheet1 و Sheet2 و Sheet3 بس في 2013 الحمد لله بيكون الوضع الافتراضي شيت واحد بس (أصلي بتخنق من حتة 3 شيتات ع الفاضي بحس إن الملف كبير ع الفاضي وكل اللي يلزمني للعمل بشكل مبدئي هو شيت ولما أحب أضيف جديد مش هيكون أمر صعب) المهم مع أوراك العمل بنلاقي الكائن المسمى بالمصنف WorkBook ودا اللي بيحوي التعابين كلها أقصد الأكواد .. طيب محدش سألني ايه المنطقة الرمادي دي ومالها ضلمة ليه كدا؟ أنا أقولك عشان إنت تنورها .. اضغط دبل كليك على Sheet1 مثلا في نافذة المشروع هتلاقيها نورت والحمد لله استعداد لبداية الاحتفال بس فيه نقطة الأكواد لو اتكتبت هنا هتأثر على الورقة دي بس ... في الحتة اللي نورت الصق الكود اللي جاي ده وأفضل تكتبه بايدك عشان أنا شايف ايدك بتترعش وخايف .. قلت لك جمد قلبك الموضوع بسيط نبدأ بكود كدا سهل ولذيذ Sub Hello_Officena() MsgBox "Hello Officena!" End Sub أول كلمة Sub يعني ابدأ صب اللي عندك .. لا غلط .. معناها إجراء فرعي Subroutine يعني بينفذ مهمة محددة. وفي آخر الكود End Sub عشان القفلة (لو فاكرين شعبان عبد الرحيم بيقول ايه في الآخر بس خلاص دي القفلة بتاعته) هنا بقا دي القفلة بتاعت الإجراء الفرعي.. طيب ايه Hello_Officena دا اسم الإجراء ودا له قواعد أول حاجة مينفعش يبدأ برقم 77Hello_Officena ولا ينفع يكون فيه مسافة زي كدا Hello Officena بس ممكن لو حبينا بدل المسافة بحط Underscore اللي هي بتيجي بـ Shift + العلامة اللي على يمين الصفر اللي في الأرقام اللي فوق مش الأرقام اللي ف لوحة الأرقام .. وبردو فيه حاجات محرمة في اسم الإجراء زي علامة # أو $ أو % أو & أو % أو النقطة أو الفاصلة أو أو .. بقولكم ايه كفاية كلام عن اسم الإجراء .. لو كان فيه حاجة غلط في الاسم هيطلع لك رسالة خطأ تعرف إن فيه حاجة مش مظبوطة!! طيب السطر اللي في النص دا هو دا الكود .. الإجراء أو المهمة المراد تنفيذها .. بتبدأ بكلمة MsgBox ودي اختصار للكلمة Message Box أي صندوق الاسم ..... والله انا سرحت بس مش همسح اللي بكتبه خلي الكلام يكون تلقائي .. ودي بنكتب وراها الرسالة اللي عايزين نظهرها .. وطبعا فيه مسافة بعد الكلمة والكلام اللي هو الرسالة دا نص فنحطه بين أقواس تنصيص " " .. واحد برق لي عينه بيقولي بتتعمل إزاي دي قول لأقتلك .. هقوله حاضر يا باشا هقولك دي بتيجي إزاي .. اضغط على Shift وبعدين حرف الطاء بس خلاص .. طبعا أقواس التنصيص في أول النص وفي آخره مهو لازم القفلة. نجرب نشغل الكود إزاي .. فيه أكتر من طريقة يا إما تضغط على مثلث لونه أخضر فوق في شريط الأدوات الموجود في محرر الأكواد .. مش عاجبك شكل المثلث الأخضر خلاص روح لقائمة Run واضغط أول أمر .. لو انت تلميذ ذكي هتعرف الطريقة التالتة من التانية .. هسيبكم تقولوها إنتو ..مش عارفين !! طيب هقول أنا وخلاص اضغط على F5 من لوحة المفاتيح بس بشرط يكون مؤشر الماوس واقف في الكود.. لما نشغل الكود دا اللي هيظهر لي وبكدا أكون وصلتكم وفتحت لكم الباب .. لو عايزين نكمل قولوا كمل مش عايزين .. يبقا كفاية لحد كدا ويا كود ما يقربش منك حد .. ونعمل بالمثل الفلاحي اللي بيقول : ابعد عن الكود وادعي عليه! والسلام عليكم سبحانك اللهم وبحمدك .. نشهد أن لا إله إلا أنت ..نستغفرك ونتوب إليك كان معكم على الهواء مباشرة أخوكم أبو البراء من ملعب أوفيسنا .. إلى اللقاء مع مباراة جديدة وأهداف جديدة وشيقة دمتم بود ====================================== ====================================== السلام عليكم نرجوا وضع ردود الشكر والاعجاب على الرابط ادناه هنا ====================================== ======================================

السلام عليكم ورحمة الله وبركاته اخي الكريم تم ربط الفورم بالجدول بالمرفقات مع تحياتي ربط شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل.rar

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

, بالنسبة للتطبيق علي الاوفيس 2003 فسيكون هناك تغييران الاول هو ضغط ALT عند اختيار درجة الامان فيضاف علامة ال % و أيضا وجود خيار جديد و هو Very High و لكن لاحظ أنك باختيار High or Very High ستمنع عمل ماكرو بدء التشغيل و بالتالي لن يتم التحويل اليا الي منخفض و يمكنك التحكم بالطريقة التي تناسبك macroSecurity.rar