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

http://im40.gulfup.com/Ltirv.jpg هذا الكتاب يعد اول كتاب باللغه العربية لتعلم لغه ال VBA http://im35.gulfup.com/saxzs.png يتناول الكتاب ما يلى:- ❑ تخزين المعلومات في المتغيرات والمصفوفات ❑ صنع القرار في التعليمات البرمجية ❑ الحلقات ❑ معالجة الأخطاء ❑ اليوزر فورم رابط التحميل http://www.mediafire.com/download/dj01xxwnczia62k/VBA+Excel.rar (هذا الكتاب يعد عمل مترجم ولا يعبر عن فكر شخصى إلا فى اجزاء منه)

السلام عليكم و رحمة الله و بركاته اخوانى و أحبابى فى أوفيسنا اليوم باذن الله تعالى أعرض عليكم تعليمة برمجية صغيرة من سطر واحد تمكنك هذه التعليمة من الضغط على أى شكل تلقائى بمعلومية اسمه . مثال : اذا كان لديك شكلا تلقائيا اسمه Picture 1 كيف تضغط عليه برمجيا لا يدويا يمكن تنفيذ ذلك من خلال هذه التعليمة : Sub clickonashape() Application.Run ActiveSheet.Shapes("Picture 1").OnAction End Sub ممارسة الضغط على الشكل Picture 1 لن تشعر به الا اذا ربطت هذا الشكل بكود معين يؤكد لك أنه تم ضغطه لنربط الشكل بالكود التالى مثلا : Sub xxx() MsgBox "Hi Officna" End Sub جرب تشغيل الكود الأول ستجد أن الكود الثانى اشتغل و ظهرت الرسالة ( Hi Officna ) تطبيق على الكود السابق : اضافة شكل تلقائى لتشغيل كود مباشرة دون ربطه يدويا فى الكود التالى تم استثمار التعليمة السابقة و لكن بشكل مختلف : يتم اضافة شكل تلقائي فى مكان محدد بالشيت و له بعض الخصائص : من ضمن هذه الخصائص : أن يكون الشكل مربوطا بكود موجود مسبقا Sub addshpjoinedwithcode() Dim shp As Shape ' اضافة الشكل فى المكان المحدد Set shp = ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, Left:=ThisWorkbook.Application.Range("E5").Left + 10, Top:=ThisWorkbook.Application.Range("E5").Top + 2, Width:=100, Height:=100) ' اضافة بعض الخصائص للشكل المضاف With shp .Name = "SmileyFace" .Fill.ForeColor.RGB = RGB(255, 192, 0) ' لون الشكل .Line.ForeColor.RGB = RGB(0, 176, 240) ' لون الخط .Adjustments.Item(1) = -2 ' الشكل يبدو عابسا .OnAction = "xxx" ' السطر الرئيسى : فى حالة ضغط الشكل يعمل الكود المحدد End With End Sub يعنى باختصار يلا يظهر الشكل تقدر تدوس عليه ليعمل الكود التالى : xxx Sub xxx() Application.ScreenUpdating = False With ActiveSheet.Shapes("SmileyFace") .Fill.ForeColor.RGB = RGB(146, 208, 80) ' لون الشكل الجديد .Line.ForeColor.RGB = RGB(192, 0, 0) ' لون الخط الجديد .Adjustments.Item(1) = 1 ' الشكل يبدو ضاحكا End With Application.ScreenUpdating = True MsgBox "Hi Officna" End Sub المرفقات : programmatically add shape , join it with specific code.rar programmatically click on a shape.rar أتمنى أن يكون الموضوع خفيفا و مفيدا لكم فى أكوادكم و برامجكم و السلام عليكم ورحمة الله وبركاته

الموضوع شكله ضاحكا واللي يعدي وميحطش اعجاب يبقي عابسا احلى لايك

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

تفضل أخى الفاضل =(HOUR(A1)*3600+MINUTE(A1)*60+SECOND(A1))/60 بفرض أن الوقت موضوع فى الخلية A1 برجاء أخى الانتباه بالنسبة لتكرار الموضوع حيث أن هذا الموضوع مكرر مرتين

عذرا أخى فقد نسيت هذه النقطة تفضل تجزئه3.rar

السلام عليكم ورحمة الله وبركاته بعد اذن أخى الحبيب ياسر خليل تفضل أخى جرب الكود التالى Sub ragab() Dim cl As Range, sh As Worksheet Dim ws As Worksheet '======================================= Set sh = Sheets("الرئيسيه") Set ws = Sheets("النموذج") '======================================= Application.ScreenUpdating = False ThisWorkbook.Unprotect "123" ws.Unprotect "123" '======================================= For Each cl In sh.Range("D4:R7") If Not IsEmpty(cl) Then x = Trim(cl) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) ws.Range("A1:k36").Copy With Sheets(x) .Select .Paste .Protect "123" End With End If End If Next '======================================= Application.CutCopyMode = False ThisWorkbook.Protect "123" ws.Protect "123" Sheets("الرئيسيه").Select Application.ScreenUpdating = False End Sub تجزئه2.rar

تمت اضافة السطر المحدد فى الصورة السابقة

ههههههههههه بس أحلى بطيخة حمرا ومرملة ودمها خفيف

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

تفضل أخى الفاضل جرب هذه الفكرة اكرم.rar

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

وبعد اذن اخى الكريم واستاذى / سليم حاصبيا واثراء للموضوع اليكم رابط وهو للأستاذ الكبير / حسام

اذهب الى العنوان حيث لي مشاركة بهذا الموضوع http://www.officena.net/ib/topic/66471-%D9%82%D8%A7%D8%A6%D9%85%D8%A9-%D9%85%D9%86%D8%B3%D8%AF%D9%84%D8%A9-%D9%85%D8%B7%D8%A7%D8%B7%D9%8A%D8%A9-%D9%85%D9%86-%D8%B5%D9%81%D8%AD%D8%A9-%D8%A7%D8%AE%D8%B1%D9%89/#comment-433091

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

بسم الله الرحمن الرحيم لاحظت في الفترة الأخيرة كثرة الأسئلة عن موضوع نسيان كلمات مرور ملفات الإكسل أو بعض ورقات العمل بالملف فأحببت أن أشارك إخوتي وأحبّتي أعضاء ومشرفي وخبراء منتدانا الرائع هذه الإضافة MasNoPass لفك حماية أوراق العمل في ملفات الإكسل وتعمدت تسهيل عملها &&&&&&&&&&& فقط تحتاج لإضافة الوظيفة الإضافية: 1 في ويندوز xp نسخ المرفق إلى المسار التالي C:\Documents and Settings\***\Application Data\Microsoft\AddIns حيث أن C هو قرص النظام و *** هو اسم المستخدم 2 في ويندوز 7 نسخ المرفق إلى المسار التالي C:\Users\***\AppData\Roaming\Microsoft\AddIns حيث أن C هو قرص النظام و *** هو اسم المستخدم ****************** بالنسبة لمستخدمي إكسل 2003 من خلال: فتح برنامج الإكسل والضغط على قائمة أدوات tools ===> وظائف إضافية Addins ===> ثم اختر MasNoPass ثم موافق ok وبالنسبة لمستخدمي إكسل 2007 يتم ذلك من خلال : فتح برنامج الإكسل والضغط على زر الأوفيس ثم خيارات إكسل Excel options ثم اختيار وظائف إضافية Addins من الجانب الأيمن/الأيسر ثم اذهب go ثم اختيار MasNoPass ثم موافق ok وبالنسبة لمستخدمي إكسل 2010 وما بعدها يتم ذلك من خلال : فتح برنامج الإكسل والضغط على قائمة ملف file ثم خيارات إكسل Excel options ثم اختيار وظائف إضافية Add-ins من الجانب الأيمن/الأيسر ثم اذهب go ثم اختيار MasNoPass ثم موافق ok /////////////////// طريقة العمل:- بعد تسجيل الوظيفة الإضافية تجد ظهور قائمة جديدة باسم (فك الحماية) وتحتاج فقط إلى فتح الملف المحمي ثم الضغط على قائمة فك الحماية واختيار (إزالة كلمة المرور) بعدها سيتم البدء في عدّ المحاولات والوقت المنقضي في إجراء العملية بعدها تظهر رسالة تفيد أنه تم إزالة كلمة المرور عن الملف وبعد الضغط على الرسالة ستجد الملف مفكوك بين يديك $$$$$$$$$$$$$$$$ و أذكّر نفسي وإياكم بأن الصحابة عليهم رضوان الله كان الواحد منهم إذا أراد أن يدعو لنفسه دعا لأخيه فيقول له الملك آمين ولك مثلها فلا ينقصني سوى دعائكم وأخيرا أذكر بخطورة الموقف وأرجو عدم استعمالها فيما حرّم الله وعند النقل يجب ذكر المصدر منتديات أوفيسنا اللهم قد بلّغت ... اللهم فاشهد أخوكم محمد صالح فيديو لشرح كيفية استعمال الأداة ولا ينقصني سوى دعاؤكم ينصح بالاشتراك في القناة وتفعيل جرس التنبيه ليصلكم كل جديد ومفيد وقت صدوره MasNoPass.rar New_MasNoPass.rar

السلام عليكم ورحمة الله وبركاته كيف حالكم إخواني الكرام في المنتدى الأغر ... هل ....؟ سؤال موجه لكم وليس لي هل .....؟ والإجابة على السؤال بهل إما بـ "نعم" أو بـ "لا" هل قمت يوماً ما بتحميل مصحف كامل لأحد القراء المحببين إليك؟ إذا كانت الإجابة بنعم انتقل للسؤال الثاني وإذا كانت الإجابة بـ "لا" .. مش عيب عليك تحمل أفلام ومسلسلات وألعاب وناسي كتاب الله السؤال الثاني : هل بعد عملية التحميل وجدت أن المجلد الذي يحتوي على السور مرقمة من 001 و 002 إلى 114 بدون أسماء السور؟ إذا كانت الإجابة بـ "نعم" فإليك الحل السحري مع الإكسل .. الحل هو دمج أسماء السور مع الاحتفاظ بالرقم أيضاً من أجل ترتيب السور ، لتصبح في النهاية بهذا الشكل 001 - الفاتحة ، 002 - البقرة وهكذا!! خطوات العمل : ************** قم بنسخ المصنف الذي سأقوم بإرفاقه في نفس مسار المجلد الذي يحتوي على السور القرآنية .. افتح المصنف .. اضغط زر الأمر .. وشكراً لكم على حسن تعاونكم معنا أترككم مع الملف :fff: Rename Quran Files.rar

السلام عليكم ممكن عمل توسيط للاسماء التي في القائمة المنسدلة تعديل.rar

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

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

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

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

اخي اسامة ... انت تعني تحويل قاعدة البيانات من accdb. الى accde. لكن عليك ان تحتفظ بنسخة للقاعدة قبل التحويل ... لان القاعدة الجديدة ذات الصيغة accde. لا يمكن التعديل عليها ... New Bitmap (2).bmp

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

السلام عليكم اذا عندك مجموعة استعلامات ، تحديث/الحاق/حذف ، وكل استعلام يعتمد على نتيجة الاستعلام الذي قبله ، فاليك ما فهمته من الكثير من المواقع على الانترنت: 1. إما ان تستخدم كود VBA بواسطة وحدة نمطية كما قال الاستاذ علي ، هكذا: . 2. واما اذا اردت ان تستعمل الماكرو ، فهناك شئ جدا مهم يجب ان تعرفه ، وهو ان الماكرو سينفّذ جميع الاوامر / الاستعلامات دفعة واحدة ، ولن يطبقها بالتسلسل الذي تريد ، بحيث ان الاستعلامات الاخرى ستبدأ بالعمل قبل ان ينتهي عمل الاستعلام الذي قبله (وخصوصا اذا كان الاستعلام بطيئا) فاذا اردت استعمال الماكرو لهذا الامر ، فالطريقة الصحيحة هي ان تغلق كل استعلام قبل البدء بإستعمال الاستعلام الذي يليه ، هكذا: SetWarnings (No) OpenQuery (Query,"اسم الاستعلام رقم 1", DataSheet, Edit) CloseWindow (Query,"اسم الاستعلام رقم 1", No) OpenQuery (Query,"اسم الاستعلام رقم 2", DataSheet, Edit) CloseWindow (Query,"اسم الاستعلام رقم 2", No) OpenQuery (Query,"اسم الاستعلام رقم 3", DataSheet, Edit) CloseWindow (Query,"اسم الاستعلام رقم 3", No) OpenQuery (Query,"اسم الاستعلام رقم 4", DataSheet, Edit) CloseWindow (Query,"اسم الاستعلام رقم 4", No) SetWarnings (Yes) جعفر

يشرفنى زيارتك الكريمة أخى الحبيب وفى انتظارك ان شاء الله

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

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

أخى الحبيب / ياسر ليست بطة واحدة ولا اثنتان بل ثلاث بطات وأكثر أنت تؤمر وتنور بلشاى كلها

أخى الحبيب / ياسر ( فاكهة المنتدى ) ربنا يبارك فيك ويديم المودة

اخى العزيز ياسر خليل أبو البراء جزاكم الله خيراً

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

أخي الكريم أحمد لقد سبقني المعلم الكبير رجب بالحل .. ولكن بالفعل أن كنت مجهز حل من بدري لكن كان ينقصني فقط كلمة السر لإضافتها للكود .. عموماً الحل قريب جداً من الحل المقدم من أخونا الغالي رجب ..فقط اختلاف بسيط ، وإليك الكود إثراءً للموضوع لا أكثر Sub CreateSheets() Dim Cel As Range, strCel As String Application.ScreenUpdating = False ThisWorkbook.Unprotect 123 Sheet2.Unprotect 123 For Each Cel In Sheet1.Range("D4:R" & Sheet1.Cells(Rows.Count, 4).End(xlUp).Row) strCel = Trim(Cel.Value) If strCel <> "" Then If Not Evaluate("ISREF('" & strCel & "'!A1)") Then Sheet2.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = strCel Cel.Hyperlinks.Add Cel, "", , "Screen_Tip", strCel Cel.Hyperlinks(1).SubAddress = "'" & strCel & "'" & "!A1" ActiveSheet.Protect 123 End If End If Next Cel ThisWorkbook.Protect 123 Sheet2.Protect 123 Application.ScreenUpdating = True MsgBox "Done ...", 64 End Sub تقبل تحياتي Create Sheets By Cells In Range & Add Hyperlinks YasserKhalil.rar

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

أخي الكريم طارق صراحة الموضوع معقد بعض الشيء لكن بفضل الله وحده تمكنت من الوصول لسبب المشكلة وهو الإجراء الفرعي في حدث الفورم اخذف الإجراء الموجود واستبدل التالي مكانه Sub ListArr(Cmd As String) Dim sTe As String: sTe = Me(Cmd).Text Dim II As Long, E As Long E = 0 For II = LBound(Arr1) To UBound(Arr1) If CStr(Arr1(II)) <> sTe And Not IsEmpty(Arr1(II)) Then E = E + 1: ReDim Preserve Arr2(E - 1) Arr2(E - 1) = Arr1(II) End If Next II ReDim Arr1(E): Arr1 = Arr2 End Sub تقبل تحياتي

حياك الله أخوي رضا الله شاكر لك سؤالك عني ، هذا من طيبك واحسانك جعفر

وجزاك الله كل خير أخى أحمد الحمد لله أن تم المطلوب

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

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

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

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

اتفضل اخى ان شاء الله يكون ما تريد بالتوفيق مرتب.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 شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ ------------------------------------------------------------------------------------------------------------------------------------ الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد انتظرونا تقبلوا تحياتى

مشاركة مع اخواني اتوقع ان طريقة ارسال التقرير بالايميل افضل مع التالي: 1. يتيح لك الاكسس ان تعمل تقرير يومي به البيانات المحددة ! فمثلا بيانات مايخص صاحب البرنامج لاتكون في التقرير المرسل 2. يتيح لك الاكسس تحويل التقرير الى pdf وارسال بريد الكتروني مرفقا به الملف كلها ممكن في خطوة واحدة وبنقرة زر خصوصا وجود الوت لوك عندك يمكنك البحث في المنتدى فبه امثلة كثيرة حول ارسال التقرير بالايميل ! او ارفاق ملف للتطبيق عليه ! بالتوفيق

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

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