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

السلام عليكم ورحمة الله وبركاته 🙂 في الواقع ، عرضت هذا الموضوع في منتدى الفريق العربي للبرمجة سابقا ، ولكني اعرضه هنا ، حتى تعم الفائدة ويستفيد منه الجميع. في بعض الاحيان نعمل برنامج بلغة معينة (العربية مثلاً) ، ثم لاحقا نريد هذا البرنامج لمستعملين بلغة اخرى (الانجليزية او الفرنسية مثلاً) ، مما يضطرنا ان نعمل نسخة اخرى من البرنامج 😞 اضع بين يديكم طريقة عمل برنامج بعدة لغات ، والطريقة هي الاحتفاظ بالمعلومات المطلوبة (ولا اقصد البيانات) في جدول. 1. هذه هي البيانات بلغات 3 ، العربية والانجليزية والفرنسية (والكلمات تم ترجمتها من الانجليزية الى الفرنسية عن طريق Google Translation): الخانات الموجودة بسيطة ومعرفة معناها لا يأخذ وقت ، اما تنسيق الحقل فهو:1. اسم الخط ، 2. حجم الخط ، 3. ثخانة الخط ، 4. منحني ، 5. تحته خط ، 6. لون الخط: 2. النموذج الرئيسي ، به واجهة البرنامج (والتي سنراها على الجهة اليمنى من الشرائح التالية) ، واول نموذج هو لعمل التغييرات على تنسيق الحقل ، وذلك بالنقر المزدوج في الحقل ، فتنفتح لنا نافذة اختيار الخط ، وعندما نطمئن لإختيارنا للخط ، يجب ان نحفظ هذا التنسيق ، وذللك للّغة التي نريدها: 3. اما النتائج المرجوة من البرنامج ، فتظهر لنا في هذا النموذج: باللغة العربية: باللغة الانجليزية: وباللغة الفرنسية: والكود الذي يقوم بجلب الكلمات والتنسيق هو التالي ، ولا يوجد حاجة الى تغيير الكود ، وانما العمل يكون بإضافة الخانات في الجدول: Private Sub Form_Load() On Error GoTo err_Form_Load mySQL = "Select * From tbl_Controls_Properties" mySQL = mySQL & " WHERE Form_Name='" & Me.Name & "'" mySQL = mySQL & " AND Language='" & Forms!frm_Main!Lang & "'" Dim rst As DAO.Recordset Dim x() As String Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst iTwips = 576 '576 twips/cm , 1440 twips/inch For i = 1 To rst.RecordCount Me(rst!ctl_Name).Caption = rst!ctl_Caption Me(rst!ctl_Name).Left = rst!ctl_Left * iTwips If Len(rst!ctl_Style & "") <> 0 Then x = Split(rst!ctl_Style, "|") With Me(rst!ctl_Name) .FontName = x(0) .FontSize = x(1) .FontWeight = x(2) .FontItalic = x(3) .FontUnderline = x(4) .ForeColor = x(5) If rst!Language = "A" Then '0=General '1=Left '2=Center '3=Right '4=Distribute .TextAlign = 3 Else .TextAlign = 1 End If End With End If rst.MoveNext Next i Exit Sub err_Form_Load: If Err.Number = 438 Or Err.Number = 13 Then 'ignor, Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub وهذا الكود الذي يفتح لنا msgbox : Public Function aRemark(N) 'call the Arabic Remarks in Table tbl_Controls_Properties aRemark = DLookup("[Remark]", "tbl_Controls_Properties", "[Form_Name]='" & Me.Name & _ "' And [Language]='" & Forms!frm_Main!Lang & _ "' And [Remark_ID] = " & N) End Function هذا البرنامج برنامج بدائي ، والذي يمكن تطويره 🙂 جعفر MultiLanguage2.zip

تم وضع هذا السطر TextBox13.Value = Format(TextBox13.Value, "yyyy/mm/dd") لتنسيق الكتابة فى TextBox13 على هيئة تنسيق تاريخ ونفس الشئ مع TextBox16

أخي الكريم إبراهيم لست متابع للموضوع من البداية ، ولكن من خلال رد أخي الغالي رجب الأخير أفهم أن المشكلة في وجود ورقة العمل من عدم وجودها لما لا تستخدم دالة معرفة تقوم بالأمر نيابةً عنك ومن خلالها يمكنك تجنب الخطأ ادرس الكود التالي جيداً وحاول تستفيد منه Sub TestRun() If Not SheetExists("Sheet1") Then MsgBox "The worksheet does not exist.", vbExclamation Else MsgBox "The worksheet already exists.", vbInformation End If End Sub Function SheetExists(strName As String) As Boolean Dim WS As Excel.Worksheet On Error Resume Next Set WS = Sheets(strName) SheetExists = (Err.Number = 0) Set WS = Nothing End Function تقبل تحياتي

أخي الكريم سعيد دعك من المشاركة السابقة وإليك الأكواد التالية ..يمكنك الآن الاستغناء عن الأكواد في حدث ورقة العمل لأنني لا أحبذها أصلاً طالما أنه بالإمكان عمل المطلوب دونها جرب الكودين التاليين أحدهما للإضافة والآخر للخصم Sub TransferMatchingData() Dim vItems As Variant, vData As Variant, vOut As Variant, I As Long vItems = Sheet1.Range("B8", Sheet1.Cells(Rows.Count, "B").End(xlUp)).Resize(, 2).Value With Sheet2.Range("B8", Sheet2.Cells(Rows.Count, "B").End(xlUp)) vData = .Value vOut = .Offset(, 1).Resize(, 2).Value With CreateObject("Scripting.Dictionary") .CompareMode = 1 For I = LBound(vItems) To UBound(vItems) .Item(vItems(I, 1)) = vItems(I, 2) Next I For I = LBound(vData) To UBound(vData) If .Exists(vData(I, 1)) Then vOut(I, 1) = .Item(vData(I, 1)) vOut(I, 2) = vOut(I, 2) + vOut(I, 1) Else vOut(I, 1) = "" End If Next I End With .Offset(, 1).Resize(, 2).Value = vOut End With End Sub Sub TransferMatchingItems() Dim vItems As Variant, vData As Variant, vOut As Variant, I As Long vItems = Sheet5.Range("C8", Sheet5.Cells(Rows.Count, "C").End(xlUp)).Resize(, 7).Value With Sheet2.Range("B8", Sheet2.Cells(Rows.Count, "B").End(xlUp)) vData = .Value vOut = .Offset(, 2).Resize(, 2).Value With CreateObject("Scripting.Dictionary") .CompareMode = 1 For I = LBound(vItems) To UBound(vItems) .Item(vItems(I, 1)) = vItems(I, 7) Next I For I = LBound(vData) To UBound(vData) If .Exists(vData(I, 1)) Then vOut(I, 2) = .Item(vData(I, 1)) vOut(I, 1) = vOut(I, 1) - vOut(I, 2) Else vOut(I, 1) = "" End If Next I End With .Offset(, 2).Resize(, 2).Value = vOut End With End Sub تقبل وافر تقديري واحترامي

تفضل أخى الجزء الخاص الطلب الأول مشاكل في الفورمة.rar

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

شكرا اخي محمد عادل وفقك الله لكل خير

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

أخى الفاضل الرقم 109 يعنى استخدام الدالة SUBTOTAL كدالة جمع مع تجاهل القيم المخفية

السلام عليكم ورحمة الله وبركاته انا اتعلم access بطريقة learn by doing اى القيام بعمل مشاريع فعلية والبحث عن ما لا اعرفه خلال العمل فى المشروع مرفق قاعدة بيانات لمخزن و ما اريد عمله هو: 1-جعل القيمة فى اذن الاضافة واذن الصرف = الكمية * السعر وتكتب تلقائياً 2-الاضافة والصرف نفترض انى اضفت كمية 3 من الصنف صاحب الكود1 ثم قمت باذن صرف وصرفت 2 اريد ان يتحول الرصيد تلقائياً فى جدول الاصناف الى 1. 3-اريد عرض تقرير بحركة الصنف من تاريخ كذا الى تاريخ كذا (اى تم اضافة الكمية أ من الصنف س بتاريخ كذا يليها تم صرف الكمية ب من الصنف س بتاريخ كذا ..الخ) 4-عندما انتقل الى سجل جديد تظل القيم داخل الـsubform كما هى وانا اريدها فارغة عند كتابة سجل جديد. 5-ماهو التخطيط الصحيح لتصميم البرنامج من جداول ونماذج لأنى اشعر اننى مخطئ فى طريقة التصميم من البداية. اعتذر بشدة عن الاطالة واذا كان هناك شرح لبرنامج به ما اريد اتمنى وضع الرابط وادعوا الله ان يزيدكم من علمه وان يجعلكم دائماً خير عون للمبتدئين. test.rar او كخطوة مبدئية للتسهيل اريد معرفة ماهو التخطيط الصحيح للبرنامج من جداول ونماذج للحصول على المخرجات التى اريدها.

شكرا لكل أخي العزيز " محمد عادل " ... شكرا لك أخي العزيز " رجب جاويش " وفقكم الله لكل خير ... أخي العزيز رجب مامعنى (109) في المعادلة على أي شي تدل...؟ أخي العزيز محمد عادل كيف يمكن أظهار صيغة المعادلة في الخليةبدل الناتج بدون فارزة مفردة أو مسافة ؟

السلام عليكم ورحمة الله بارك الله فيك عمل ممتاز ودالة( sum vis) عبقرية

ضع هذا الكود Private Sub CommandButton2_Click() TextBox4 = Val(TextBox5.Value) + 1 'لتحديد تكست4 TextBox4.SetFocus End Sub

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

بارك الله فيك أخى ابراهيم حل آخير جربه وهو الغاء ظهور الرسالة أصلا والاكتفاء بازالتها استبدل السطرين دول فى كود الليبل kh_Err: If Err Then MsgBox "Err.Number : " & Err.Number: Err.Clear بالسطرين دول kh_Err: If Err Then Err.Clear مع خالص تقديرى

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

أخى رجب و حدود الدول أيضا أخى ابراهيم جرب تحط اسم الملف فى متغير dim wb as workbook set wb = activeworkbook وفى نهاية الكود On Error GoTo 1 :1 Application.Goto wb

أخى مختار انها عدوى الزهايمر تتخطى حدود المحافظات ههههههههههههه

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

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

بارك الله فيكما أستاذى رجب وأستاذى ياسر و جزاكما خيرا أخى ابراهيم الكود توقف لأنك طبقته على ملف جديد مش الملف 1 المرفق فى مشاركتك الاولى Activate .("اسم الملف") Workbooks لتنشيط الملف و تم اضافة هذا السطر لأن الكود ينشئ ملفا جديدا بأوراق عمل جديدة فصار هذا الملف الجديد هو الملف النشط لذا عند الضغط على زر غلق الفورم x لايدرى اكسل أيهما يغلق ( الفورم أم الملف الجديد النشط ) ولذلك يحدث هذا الخطأ وبناء عليه لجأت الى تنشيط الملف الأصلى مرة أخرى والله أعلى وأعلم

السلام عليكم أخى ابراهيم مصدر الخطأ فى هذا الكود فعلا هو هذا السطر If Len(Worksheets(name.Value).name) = 0 Then حيث أن الكود عندما يريد انشاء صفحة جديدة يبحث أولا هل اسم الذى سوف يضعة للصفحة موجود أم لا واذا كان اسم الصفحة غير موجود يعطى الكود الخطأ الذى رقمه 9 ( والذى يعنى خارج النطاق ) ولتخطى الخطأ والذهاب الى السطر التالى تم اضافة السطر التالى فى اول الكود On Error Resume Next وقد قمت بتجربة حل الأستاذ مختار وعمل بشكل سليم ويمكنك أيضا حذف الجزء Workbooks("1").Activate وتكتفى بالجزء التالى للتخلص من الخطأ On Error GoTo 1 1: End Sub وهذا والله أعلم

صباح الخير للجميع واسعد الله ايامكم بكل خير اخي السيد ابو البراء انتو ما قصرتو معي و ساعدتوني وانا بقدر هادا الشي وممتنه لاهتمامكم و رحابة صدركم ، وعزيزي السيد عبد العزيز سامحك الله - لم تكن معلوماتي مملة بالعكس ارت ان تكون ميسرة و قريبة للاستيعاب ، وربي يجعل تعاونك بالمنتدى بميزات حسناتك . قال صلى الله عليه وسلم: (وعَوْنُكَ الضعيفَ بِفَضْلِ قُوَّتِكَ صدقة)

Private Sub UserForm_Activate() Do DoEvents Label1 = Format(Now, "dd . mmmm . yyyy hh : mm : ss") Loop End Sub الكود التالي لو كنت تريد وضعه في Label1 تفضل سيدي و أنا تعلمته من هذا المنتدى المحترم و اغتنم الفرصة لأشكر اساتذة المنتدى المحترم و الأقوى

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

أخي الكريم الشيباني يرجى تغيير الرقم 1 في اسم الظهور ليعبر عن لقبك وعن شخصكم الكريم جرب الكود التالي لتحويل الخلايا التي تحتوي على معادلات إلى قيم ... رغم أنك أربكتني حيث أن عنوان الموضوع "تحويل المعادلات إلى قيم" واسم الملف المرفق "تحويل معادلات إلى قيم" والشرح داخل الملف المرفق "تحويل المعادلات إلى قيم" ، أما في شرح المطلوب في الموضوع ذكرت العكس أنك تريد إعادة تحويل القيم إلى معادلات .. عموماً جرب السطر التالي من الكود Sub ConvertFormulasToValues() Range("A6").CurrentRegion.SpecialCells(xlCellTypeFormulas).Value = Range("A6").CurrentRegion.SpecialCells(xlCellTypeFormulas).Value End Sub تقبل تحياتي

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

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

وعليكم السلام هذه طريقتي: http://www.officena.net/ib/topic/59818-اعمل-برنامجك-بعدة-لغات-وببساطة/ جعفر

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

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

أخي الكريم لا تنسى أن تغير اسم الظهور للغة العربي جرب التعديل التالي .. تم إضافة كود فرعي لعمل الطلب الجديد ألا وهو فرز البيانات بناءً على عمود الاسم ثم تم استدعاء الإجراء الفرعي داخل الكود الأساسي Sub GetData() Dim Col As Long Dim Data As Variant Dim Dict As Object Dim N As Long Dim Rng As Range Dim Row As Long Dim Table As Variant Dim Wks As Worksheet Dim Addr As String Set Dict = CreateObject("Scripting.Dictionary") Dict.CompareMode = vbTextCompare ReDim Table(1 To 6, 1 To 1) For Each Wks In ThisWorkbook.Worksheets If Wks.Name <> "تصفية حسب الأشهر" Then Set Rng = Wks.Range("A1").CurrentRegion.Columns(2) Set Rng = Intersect(Rng, Rng.Offset(1, 0)).Resize(ColumnSize:=2) Col = Col + 1 Data = Rng.Value Addr = Rng.Address For N = 1 To UBound(Data) If Not Dict.Exists(Data(N, 1)) Then Row = Row + 1 Dict.Add Data(N, 1), Row ReDim Preserve Table(1 To 6, 1 To Row) Table(Col, Row) = Data(N, 2) Else Table(Col, Dict(Data(N, 1))) = Data(N, 2) End If Next N End If Next Wks Table = Application.Transpose(Table) With Worksheets("تصفية حسب الأشهر") .Range("B2").Resize(Dict.Count, 1).Value = Application.Transpose(Dict.Keys) .Range("C2").Resize(UBound(Table, 1), UBound(Table, 2)).Value = Table End With Call SortData End Sub Sub SortData() Dim WS As Worksheet Dim LR As Long Set WS = Sheets("تصفية حسب الأشهر") With WS LR = .Range("A" & Rows.Count).End(xlUp).Row .Range("B1:H" & LR).Sort Key1:=.Range("B1:B" & LR), Order1:=xlAscending, Header:=xlYes End With End Sub تقبل تحياتي

أخي الكريم مهند يرجى تغيير اسم الظهور للغة العربية إليك الملف التالي فيه حل بالكود بدلاً من التعامل مع المعادلات التي تثقل الملف في حالة التعامل مع كم هائل من البيانات أرجو أن يفي بالغرض Sub GetData() Dim Col As Long Dim Data As Variant Dim Dict As Object Dim N As Long Dim Rng As Range Dim Row As Long Dim Table As Variant Dim Wks As Worksheet Dim Addr As String Set Dict = CreateObject("Scripting.Dictionary") Dict.CompareMode = vbTextCompare ReDim Table(1 To 6, 1 To 1) For Each Wks In ThisWorkbook.Worksheets If Wks.Name <> "تصفية حسب الأشهر" Then Set Rng = Wks.Range("A1").CurrentRegion.Columns(2) Set Rng = Intersect(Rng, Rng.Offset(1, 0)).Resize(ColumnSize:=2) Col = Col + 1 Data = Rng.Value Addr = Rng.Address For N = 1 To UBound(Data) If Not Dict.Exists(Data(N, 1)) Then Row = Row + 1 Dict.Add Data(N, 1), Row ReDim Preserve Table(1 To 6, 1 To Row) Table(Col, Row) = Data(N, 2) Else Table(Col, Dict(Data(N, 1))) = Data(N, 2) End If Next N End If Next Wks Table = Application.Transpose(Table) With Worksheets("تصفية حسب الأشهر") .Range("B2").Resize(Dict.Count, 1).Value = Application.Transpose(Dict.Keys) .Range("C2").Resize(UBound(Table, 1), UBound(Table, 2)).Value = Table End With End Sub تقبل تحياتي Grab All Data From All Sheets YasserKhalil.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 شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ ------------------------------------------------------------------------------------------------------------------------------------ الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد انتظرونا تقبلوا تحياتى

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

عن أنس بن مالك قال: قال رسول الله صلى الله عليه وسلم : "إن من الناس مفاتيح للخير مغاليق للشر، وإن من الناس مفاتيح للشر مغاليق للخير، فطوبى لمن جعل الله مفاتيح الخير على يديه، وويل لمن جعل الله مفاتيح الشر على يديه" [ابن ماجه ح237، وابن أبي عاصم في السنة، وحسنه الألباني بطرقه ، السلسلة الصحيحة ح1322] View the full article

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