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

بسم الله الرحمان الرحيم السلام عليكم تحياتي لجميع اعضاء اوفيسنا المحترمين الموضوع ليس بجدبد فقد تم التطرق له من قبل الاستاد القدير عبد الله باقشير جازاه الله خيرا و ان شاء الله نراه بينانا في المنتدى عن قريب لمتابعتي المنتدى في الاونة الاخيرة رئيت عدت تسائلات عن البحث والتعديل في الجداول و رئيت العديد من الحلول فحاولة الاجتهاد و الوصول الى ابسط و اسهل طريقة لعمل ذلك لذى فكرة في برمجة فورم مرن يكون ملائم لاي جدول مهما كان عدد صوفوفه او عدد اعمدته و لكي يتمكن اي عضو مهما كانت معرفته بالبرمجة ضعيفة من استعماله بسهولة ووصلة الى هذا الفورم الذي ارجو ان اكون قد وفقت في فكرته وان يستفيد منه الاغلبية يتميز هذا البرنامج يجلب الجدول المستهدف للعمل عليه و امكانية البحث داخله بدلالة اي عمود من اعمدته كما ان البحث يتميز بالبحث بأول حرف من الكمة او اي جزء منها حسب احتياجك وايضا تتميز عملية البحث بالسرعة الفائقة لاني اعتمدت على المصفوفات للوصول الى ذلك و تعرفون قوة المصفوفات و فعاليتعها اما بخصوص التكستبوكس و الكمبوبكس فتنشأ برمجيا على حسب عدد اعمدة الجدول نأتي الان الى طريقة استعمال الفورم هذا مع ملفك الخاص اولا اذهب الى محرر الاكواد تجد موديل باسم ModulePublic تجد في بدايته هذين الكودين او التعريفين ان صح التعبير Public Const sNomFeuil As String = "data" 'اسم ورقة العمل التي تحمل قاعدة البيانات Public Const sTableau As String = "tbData" ' اسم جدول قاعدة البيانات اضن ان الامر واضح تصع اسم الشيت الذي يحوي الجدول مكان عبارة "data" واسم الجدول نفسه مكان عبارة "tbData" ملاحظة : يجب ان تكون قاعدة البيانات عبارة عن جدول لايهم عدد اعمدة ولا صفوفه المهم ان يكون جدول باتباعك الخطوات السابقة تكون قد انتهيت من ربط جدولك مع الفورم ثانيا نأتي الى الاعمدة التي تحتاج قوائم في مثالنا لدين العمود 4 و العمود الاخير يحتاجون ان يمثلو في الفورم على شكر قوائم (كمبوبكس) لتنفيذ ذالك قم بأنشاء القوائم الازمة في اي شيت تريد و اعطي كل مدى قائمة اسم معين في المثال الخاص بنا سمينا نطاق قائمة الجنس ب list1 كما هو موصح في الصورة ثم اذهب الى رأس العمود المستهدف قم بادراج تعليق له و اكتب داخل التعليق نفس اسم نطاق القائمة و انتهى الامر ارجو ان اكون قد وفقت في الشرح وان يستفيد أكبر عدد من الاعضاء من هذا العمل ملاحضة: تنسيق عرض اعمد اليست يكون بتنسيقك ععرض اعمدة الجدول نفسه من الشيت و الفورم يكتشف العمود الذي يحوي تواريخ تلقائيا اي ملاحظة او استفسار او اضافة تحتاجونها للفورم لا تترددو في طلبي اهدي هذا العمل الى الغائبين الحاضرين في قلوبنا الاخ ضاحي الغريب و الاستاد عبد الله باقشير تحياتي للجميع UserForm Flexibles.rar

جرب هذه المعادلة في الخلية E2 واسحب نزولاً (يحب استعمال Ctrl+Shift+Enter و ليس Enter وحدها لانها معادلة صفيف) Array_Fromula) كما يجب نتسيق الخلايا في العامود E كتاريخ =INDEX(البيانات!$R$2:$AD$1000,MATCH(الخلاصة!A2,البيانات!$H$2:$H$1000,0),(MATCH("Ok",IF(NOT(INDEX(البيانات!$R$2:$AA$1000,MATCH(الخلاصة!$A2,البيانات!$H$2:$H$1000,0),)),"Ok"),0))-1) اذا لم تعمل معك المعادلة استبدل الفاصلة "," بفاصلة منقوطة ";" (حسب اعدادات الجهاز عندك ) لتصبح هكذا =INDEX(البيانات!$R$2:$AD$1000;MATCH(الخلاصة!A2;البيانات!$H$2:$H$1000;0);(MATCH("Ok";IF(NOT(INDEX(البيانات!$R$2:$AA$1000;MATCH(الخلاصة!$A2;البيانات!$H$2:$H$1000;0);));"Ok");0))-1)

الاخوه الاحباء لا اريد ان اشرح عن البرنامج لانه مرفق لكم الملف + الشرح ارجوا قراءة الشرح اولا لان الملف محمي ولايمكن الدخول له الا بعد معرفة رمز الدخول وتعمدت ان اضع رموز الدخول في ملف الشرح حتى اضمن انك قد قرأت الشرح وفهمته جيدا ارجوكم ان وجد اي خطأ او اي مقترح ان ترشدوني اليه حتىنعمل سويا على تطويره ان وجد والله ولي التوفيق SYSTEM USER.rar

اخواني الكرام اضع بين ايديكم الجزء الاول من شرح الترحيل وبإنتظار تعليقاتكم واستفسارتكم ابواحمد الجزء الاول من الشرح ملف شرح الجزء الاول الترحيل.rar الجزء الثاني من الشرح ملف شرح الجزء الثانى الترحيل2.rar الجزء الثالث من الشرح (ترحيل القيم - ترحيل محدوود) ملف شرح الجزء الثالث الترحيل3.rar الجزء الرابع من شروحات الترحيل ملف شرح الجزء الرابع ترحيل حسب اسم الشيت.rar لا تنسوني أخوتي من الدعاء لي بظهر الغيب

السلام عليكم كان المفروض ان يكون هذا الموضوع كجواب للموضوع والمشكلة هي ان ارقام التسلسل بالعربي ، في كل من التقارير الفرعية ليست بالتسلسل المطلوب ، ولا السنه بالتسلسل الصحيح . نعرف اذا اردنا ان نعمل اكثر من عمود في التقرير ، فاننا نستعمل اعدادات الصفحة في التقرير . اذا التقرير بالانجليزي ، فكل شيء تمام وبالترتيب/التسلسل المطلوب ، ولكن للأسف لما نريد الاعمدة بالتسلسل العربي ، من اليمين الى اسفل ، ثم يُكمّل العمود الثاني من حيث انتهى الاول ، هكذا . فهنا يجب ان نقوم بمعالجة الموضوع بطريقتنا الخاصة استعنت بالبرنامج من الروابط اعلاه ، وعملت تجارب على عدة اعمدة: 2 الى 6 اعمدة ، وكتبت نتائجها في الاكسل ، لأرى النتائج بصورة مباشرة ، الحالي معناه ما يعطينا الاكسس ، والمفروض هو التسلسل الذي نسعى لعمله . وبعد التمعن في الارقام لعدة ايام ، توصلت الى ان هناك لوغاريثم معين يتماشى مع ارقام الاعمدة وتسلسلها ، وبعد تجربة عدة طرق توصلت لطريقة تعرض هذه الاعمدة بالطريقة التي نريدها 1. سنحتاج الى حقلين اضافيين في الجدول (لكل تقرير فرعي) ، حقل تسلسل الاعمدة (وسيكون مخفي ، باللون البرتقالي في الصورة ادناه) والذي سيعتمد عليه التقرير في فرز البيانات ، rpt2_Seq مثلا، وحقل للتسلسل الذي سنراه في التقرير ، Seq2 مثلا (الحقل الآخر في التقرير) ، 2. في التقرير ، هكذا نجعل فرز البيانات ، على اساس الحقل rpt2_Seq . وبما ان التقرير الرئيسي يحتوي على 3 تقارير فرعية (في برنامج الرابط اعلاه) ، . فوضعت الكود على حدث "التنسيق" لرأس التقرير Page Header ، وهذا هو الكود ، والذي نراه انه ينادي الدالة ("Call Seq_Records(2, "rpt2_Seq", "Seq2") ، لكل تقرير فرعي ، ويرسل عدد الاعمدة المطلوبة ، واسم حقلي التسلسل في الجدول للتقرير الفرعي: Option Compare Database Dim rst As DAO.Recordset Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) 'Seq the subform Records 'rpt2 Set rst = CurrentDb.OpenRecordset("Select * From qry_2 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt2_Seq", "Seq2") 'rpt3 Set rst = CurrentDb.OpenRecordset("Select * From qry_3 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt3_Seq", "Seq3") 'rpt4 Set rst = CurrentDb.OpenRecordset("Select * From qry_4 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt4_Seq", "Seq4") End Sub . وهذا كود الدالة ، والتي يمكن إخراجها من التقرير وجعلها وحدة نمطية مستقلة) : Function Seq_Records(N As Integer, Seq_fName As String, Seq_n As String) On Error GoTo err_Seq_Records 'N = Number of columns 'Seq_fName = Seq Field Name 'Seq_n = Seq rst.MoveLast: rst.MoveFirst RC = rst.RecordCount c_Columns = N 'Number of columns in the report r_Records = RC 'Number of Records in the report j_First = c_Columns 'Start rtp_Seq with this number Counter = 0 'each time reduce c_Columns by this Counter For i = 1 To RC rst.Edit rst(Seq_fName) = j_First rst(Seq_n) = i 'Debug.Print "rtp_Seq=" & j_First & vbTab & "Seq=" & i rst.Update 'rtp_Seq j_First = j_First + c_Columns 'rpt_Seq cannot be > RC If j_First > RC Then 'start Counter Counter = Counter + 1 'rpt_Seq re-calculate j_First = c_Columns - Counter End If rst.MoveNext Next i Exit_Seq_Records: rst.Close: Set rst = Nothing Exit Function err_Seq_Records: If Err.Number = 3021 Then Resume Exit_Seq_Records Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . والنتيجة: . كما عملت تقرير للتجربة وبه 4 اعمدة ، والذي ينادي الدالة هكذا ("Call Seq_Records(4, "rpt2_Seq", "Seq2") ، والنتيجة . جعفر 680.4.الاجازات.accdb.zip

السلام على جميع الاخوة الافاضل اما بعد : بعد المعلومات الكثيرة التي استفدت منها من خلال هذا الموقع الذي اصبحت مدمنا عليه ولا استطيع مفارقته افادني الاساتذة الى ضرورة عدم الاكثار من ادراج يوزرفورم في الملف حتى لا يأخذ حجم كبير و يكون خفيف نوعا ما لذلك هناك العديد من الاخوة و انا واحد منهم من يفضل عمل فورم واحدة لتقوم بمختلف العمليات وحتى استغني عن فورم ادراج رقم سري للدخول الى الملف وجدت العديد من الملفات التي حملتها من بعض المواقع الاجنبية يفضلون استعمال input box بدلا من استعمال فورم . بدون اطالة اليكم اخوتي الكود التالي ربما يفيد بعض المبتدئين امثالي ولكم مني خالص عبارات الشكر. 'يوضع هذا الكود في this workbook Sub Auto_Open() Application.Visible = False Dim UserName As String UserName = InputBox("Please Enter Your USER NAME.") If UserName = "123456" Then ' اكتب هناالرقم السري للدخول MsgBox "Correct" UserForm1.Show 'هنا اذا كان لديك يوزر فورم اما اذا لم يكن لديك فورم يمكن مسح هذا السطر Exit Sub Else MsgBox "Incorrect" End If ActiveWorkbook.Save Application.Quit End Sub

بارك الله فيك استاذ ياسر على مرورك الطيب وملاحظتك التي اعتز بها شكرا لك

وعليكم السلام أخي الكريم زياد جرب الكود التالي في حدث ورقة العمل المراد التجميع فيها قم بكتابة القسم في العمود الثاني .. Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim xf As Variant If Target.Cells.Count > 1 Then Exit Sub If Target.Row > 3 And Target.Column = 2 Then Application.EnableEvents = False If Target = "" Then Target.Offset(, -1).ClearContents: Target.Offset(, 1).Resize(, 6).ClearContents: GoTo Skipper For Each ws In ThisWorkbook.Worksheets(Array("وحدة الانتاج", "وحدة النقل", "وحدة التوزيع")) xf = Application.Match(Target, ws.Columns(2), 0) If IsNumeric(xf) Then Target.Offset(, -1) = Target.Row - 3 Target.Offset(, ws.Index * 2 - 1) = ws.Cells(xf, 3) Target.Offset(, ws.Index * 2) = ws.Cells(xf, 4) End If Next ws Skipper: Application.EnableEvents = True End If End Sub

بارك الله فيك أخي العزيز زيادة فكرة جميلة وبسيطة وأفضل من وجهة نظري من الفورم إذ أن المهم الأداء العملي والفعلي للملف ..لا مجرد جماليات وفارغ من المضمون

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

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

السلام عليكم ورحمة الله وفي الملف المرفق تطبيق بفكرة استبدال 6 أعمدة مساعدة (أو بالأحرى 7 أعمدة مساعدة) بعمود واحد مساعد تم فيه دمج كل المعادلات في معادلة واحدة باستعمال الدالة SUMPRODUCT فقط... بن علية حاجي Rank.rar

وعليكم السلام جرب الكود التالي عله يفي بالغرض Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim temp As Variant Dim x As Variant Dim i As Long Dim j As Long Dim k As Long Set ws = Sheets("البيانات") Set sh = Sheets("الخلاصة") arr = sh.Range("A2:A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim temp(1 To UBound(arr, 1), 1 To 1) k = -1 Application.ScreenUpdating = False For i = LBound(arr, 1) To UBound(arr, 1) k = k + 1 x = Application.Match(CStr(arr(i, 1)), ws.Columns(8), 0) If IsNumeric(x) Then For j = 18 To 29 If ws.Cells(i, 18) = "" Then GoTo Skipper If ws.Cells(i, j) = "" Then temp(k, 1) = ws.Cells(i, j - 1): GoTo Skipper Next j Else temp(k, 1) = "" End If Skipper: Next i sh.Range("E2").Resize(k, UBound(temp, 2)).Value = temp Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله ممكن في خطوتين بعد استبدال 6 أعمدة مساعدة بعمود واحد مساعد (بدمج كل معادلات هذه الأعمدة الستة في عمود واحد)... وليس لي فكرة أخرى... بن علية حاجي

السلام عليكم ورحمة الله تم التعديل على ملف أخي سليم مع بعض الإضافات... بن علية حاجي TARTIB.rar

البداية للنسخ هو آخر صف حيث يتم عمل تعبئة تلقائية لآخر صف ... ولمدى عدد الصفوف المطلوبة طبقاُ للمتغير c الذي يشير للخلية Q1

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

و في حال تساوي رقمين او اكثر ما هي التنيجة

الله عليك أستاذى سليم الحل السهل الممتنع تقبل تحياتى

لان عندك تقرير اخر وبيظهر التكرار فيه لذالك هذا الكود بيعمل المطلوب On Error Resume Next If DCount("*", "q1") = 0 Then MsgBox "ليس لدينا اي سجل مکرر" Else DoCmd.SetWarnings False DoCmd.OpenQuery "QUERY1", acViewNormal DoCmd.SetWarnings True Me.Requery End If

السلام عليكم ورحمة الله المعايير التي وضعتها غير مفهومة، وهذه محاولة في الملف المرفق، بعض النتائج متوافقة مع ما تنتظره... أرجو أن تكون الفكرة قريبة من المطلوب وليس لي اقتراحات أخرى... بن علية حاجي Rank.rar

على الرغم انت ما فهمت من سؤالي الاول لكن اتفضل بواسطة هذه الاستعلام سيبقى كل صنف سجل واحد DELETE [Table-1].ID, [Table-1].L, [Table-1].M, [Table-1].D FROM [Table-1] WHERE ((([Table-1].ID) Not In (SELECT First(id) FROM [Table-1] GROUP BY L;))); اي سيخليه سجل الاول من كل الصنف وسيحذف الاخر واليك ملفك بعد تعديل الاصناف المتكررة.rar

جرب المثال بعد التعديل ، scan2.rar

الیک ھذا الكود Private Sub ملاحظات_GotFocus() Me.ملاحظات.KeyboardLanguage = 3 End Sub غير ( ملاحظات ) باسم مربع نصي عندك

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

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

الان وصلت الفكرة اليك حل افضل بكثير من طريقتك عملت لك هذه الاستعلا الالحاق INSERT INTO Transactions ( Doc, Code, Item, Out, Notes ) SELECT [Forms]![Trans_top10]![Transaction subform].[Form]![Invoice] AS Doc, Order_Sub.Code, Order_Sub.Item, [Forms]![Trans_top10]![Transaction subform].[Form]![Out] AS Out, Order_Sub.Notes FROM Order_Sub WHERE (((Order_Sub.ID)=[Forms]![Trans_top10]![Combo0])); وفي خلف زر استخدمت هذا الكود Private Sub Command95_Click() Me.Transaction_subform.SetFocus DoCmd.SetWarnings False DoCmd.OpenQuery "q1", acViewNormal DoCmd.SetWarnings True End Sub اليك ملفك بعد تعديل Pro.rar

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

فقط عليك ان تحذف هذه من الكود 'If Not IsNull(PicFile) = True Then '.InitialFileName = PicFile 'Else '.InitialFileName = "" 'End If ولهذا اضفت هذه اسطر للكود Dim newa As String newa = Mid$(Trim(.SelectedItems(1)), InStrRev(Trim(.SelectedItems(1)), ".") + 1) If newa = "jpg" Or newa = "png" Or newa = "ico" Or newa = "bmp" Or newa = "gif" Or newa = "tif" Or newa = "tga" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\" & PicName("" & xPic & "") ElseIf newa = "mp3" Or newa = "wma" Or newa = "ape" Or newa = "amr" Or newa = "wav" Or newa = "mp4" Or newa = "avi" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\watch\" & PicName("" & xPic & "") ElseIf newa = "txt" Or newa = "docx" Or newa = "doc" Or newa = "exlx" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\doc\" & PicName("" & xPic & "") End If وتقدر ان تضيف انواع اخرى من نوع القراءة مثلا بي دي اف و الخ الى الكود تيكست اي الى جملة الشرطية و ايضا لنوع الفيديو اليك المرفق بعد تعديل test_move.rar

عاشت ايدك مضبوط

اليك هذا الكود Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 122 KeyCode = 0 End Select End Sub لكن لازم تتغير خاصية Key Preview الى نعم للنموذج او يجب تستخدم هذا الكود معه Private Sub Form_Open(Cancel As Integer) Me.KeyPreview = True End Sub تحياتي

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

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

السلام عليكم اخي جمال الفار تفضل دالة استخلاص تاريخ الميلاد من الرقم القومي.rar