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

عجبنى الموضوع ده قلت أشاركه معكم بإختصار هو سكريبت لعمل مكان موثوق لملفات الأكسيس من مكان تشغيله .. بمعنى لو شغلته من Desk Top تقدر تفتح أى ملف أكسيس على Desk Top بدون ظهور Enable Content. ولو عندك فولدر لمشاريعك فى أى مكان سواء سى أو دى أو .... ضع هذا السكريبت داخله وشغل وخلاص بقى كل ما بداخل الفولدر منطقة أمان. إنشئ ملف نص بأى إسم وضع فيه ما يلى على أن تغير إمتداده الى vbs. Const HKEY_CURRENT_USER = &H80000001 Dim oRegistry Dim sPath Dim sDescription Dim bAllowSubFolders Dim bAllowNetworkLocations Dim bAlreadyExists Dim sParentKey Dim iLocCounter Dim arrChildKeys Dim sChildKey Dim sValue Dim sNewKey Set WshShell = CreateObject("WScript.Shell") strCurDir = WshShell.CurrentDirectory Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv") sPath = strCurDir sDescription = "YourTrustedLocationDescriptionGoesHere" bAllowSubFolders = True bAlreadyExists = False sParentKey = "Software\Microsoft\Office\16.0\Access\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\Excel\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\PowerPoint\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\Word\Security\Trusted Locations" iLocCounter = 0 oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys For Each sChildKey in arrChildKeys oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue If sValue = sDescription Then bAlreadyExists = True If CInt(Mid(sChildKey, 9)) > iLocCounter Then iLocCounter = CInt(Mid(sChildKey, 9)) End If Next 'If bAlreadyExists = False Then sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1) oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription If bAllowSubFolders Then oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1 End If كما يمكن تفعيله للاكسيل والوورد والباور بوينت مع مراعاة نسخة الاوفيس لديك وتغيرها فى الكود: أوفيس 2019 : 16.0 أوفيس 2016 : 16.0 أوفيس 2013 : 15.0 أوفيس 2010 : 14.0 أوفبس 2007 : 12.0 أوفيس 2003 : 11.0 أظن أنه لا يوجد أحد أعضاء منتدانا الكريم يعمل على أوفيس XP 😊 عسى أن يفيد .. إذا اشتغل يعنى والله الموفق EAR TrustAnyWhere.zip

السلام عليكم حمل نسخة تجريبية من برنامج محاسبة الشركات الاصدار الرابع account_Prog_new2020_test-برنامج محاسبة الشركات الاصدار الرابع.rar

بارك الله فيك وزادك الله من فضله

تفضل يمكنك استخدام نفس معادلة Sumifs , المشكلة كانت لديك فى الملف لإختلاف كتابة اسم الصنف لابد من المطابقة دائما بين الأسماء لكى يتم عمل الدالة بكفاءة =SUMIFS($D$3:$D$900,$C$3:$C$900,$G3,$E$3:$E$900,H$2) 1000.xlsx

اتفضل Function Date.mdb

بارك الله فيك وزادك الله من فضله

الأخ العزيز حسن بابكر .. قد تفضل أخوىّ العزيزان kha9009lid و ابا جودى بالرد عليك بكل ما يخص الموضوع من صلة سواء حساب عدد الكلمات أو عدد الحروف. ولذلك إن تفضلت علينا لا تفتح موضوعا جديدا لنفس السؤال .. يكفيك كتابة مثلا "للرفع" فى نفس الموضوع وبعد إذن أساتذتى قد طبقت أحد امثلتهم على برنامجك فتفضل عسى أن يفى بما طلبت. eta.zip

انظر الى هذا الرابط سيتضح لك الأمر https://www.excel-easy.com/vba/examples/resize.html

وعليكم السلام -اهلا بك ونورتنا بالمنتدى تفضل

بارك الله فيك استاذ سليم وهذا يتم بمعادلة المصفوفة -فلابد من الضغط على Ctrl+Shift+Enter وليس Enter فقط كباقى المعادلات =IFERROR(INDEX($D:$D,SMALL(IF($A:$A=$G$5,IF($B:$B>=$H$5,IF($B:$B<=$H$6,ROW(B$6:B$7000)-ROW(B$6)+1))),ROWS($K$6:K6))),"") Book11.xlsx

حل مشكلة اختفاء ورقة الخصائص الشرح الاتى نقلا عن الاستاذ الفاضل معلمى الاستاذ @Shivan Rekany اتيت اليكم بالشرح نقلا عنه لمن يريده تفصيلا ولكن هدانى الله الى ان اضع الاوامر على زر امر مباشرة لسهولة التعامل واختصارا لكل تلك الخطوات واهديكم هذه الثاعدة التى تخص حل تلك المشكلة للعلم لن استطيع فى الوقت الحالى التجربة على اكثر من نسخة مختلفة لذلك لغفروا لى ان كانت فكرتى المتواضعة تعجز عن خل المشكلة مباشرة عند اختلاف النسخ property sheet visible or not.mdb

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'sex جنس العملة " 'FALSE ( فارغ او صفر مذكر ) " 'TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'sNameCurr اسم العملة الرئيسية مفرد " 'pNameCurr اسم العملة الرئيسية جمع " 'NameCurrDec اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- 'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة Private Const MyBegTx As String = "فقط " ' "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), zt) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(sex)) Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count) '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", " و") nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String Dim Td$, Td1$ On Error GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td Td1 = " و " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function دالة تحويل الرقم الى نص عربي.rar ================================================= الملف المعدل: هذا المرفق بامكانية تفقيط الكسر وامكانية ادخال كلمة نهاية النص دالة تحويل الرقم الى نص عربي.rar ================================================= رابط مباشر للملف

السلام عليكم جرب هذا لعله يكون مطلوبك آسف لم أتمكن من التجربة وآسف علي التأخير فلم أتمكن من الطلاع علي المرفق الا الآن جرب ووافنا بالنتائج fatoraedit.accdb

و قيك يركة اخي ربما اخترت نمط حدود تلك المربعات شفاف او عملت حدود بخطود و الامر سهل ان شاء الله في كل حالتين If Rcount > 37 And Rcount < 100 Then ممكن ولكن بشرط ادخال تاريخ في مربع نص لا من باراميترا او عمل نموذج و الماكرو لحفظ باراميترا لاستخدام في نماذج و تقارير... و للعلم الملفك الحالي لايزال يحتاج بعض تعديلات ك ملء صفحات على تساوي حتى مع تغير ارتفاع رأس و تذييل و هضبط لك لاحقا حسب الفراغ ان شاء الله

اخي @essam rabea الاستاذ لا يستاذن من تلميذه محبتي وتقديري لك

قطرة فى محيطكم أخى kanory

وهذا ملف الاخ @ابا جودى بتنسيق 2003 eta.mdb

هذا ملفك بعد استيراد ما قام به الاخ @kha9009lid مشكورا eta.accdb

طريقة ممتازة اخي @essam rabea .بارك الله فيك

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

. New Microsoft Excel Worksheet1.xlsx

ممكن هذه المعادلة ان تحل المشكلة =SUMPRODUCT(--($C$3:$C$100=$G3),--($E$3:$E$100=H$2),$D$3:$D$100) 10.xlsx

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

اهلا بك فى المنتدى مشاركة مخالفة للقوانين ولمبادىء المنتدى!!!! فيجب عند رفع اى مشاركة لابد من رفع ملف وشرح المطلوب عليه بكل دقة

شاشات جميلة ومتعوب عليها ولكن يوجد بعض الازرار لا تعمل مثل كشف حساب عميل , مورد ، المربح من الممكن ان تكون غير مفعله في النسخة التجريبية

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

هل هناك مكتبات مفقودة . راجع محرر الاكواد Tools->References وعلى كل جرب المرفق الاتى GetNetTime.mdb

أحسنت استاذ مجدى كلها أعمال رائعة جعلها الله فى ميزان حسناتك

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

السلام عليكم ورحمة الله يجب وضع اسماء الصور فى العمود "B" بجوار الارقام اليك الملف المعلومات المدنية.rar

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

بارك الله فيك وزادك الله من فضله

أحسنت استاذ مجدى عمل رائع بارك الله فيك

تفضل ghaleb1.xlsx

بارك الله بك استاذ علي و زيادة في توضيح الامور هذا الملف From To.xlsx

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

تفضل لك ما طلبت بهذه المعادلة =IF(A2=A1,C1+1,1) تجربة.xlsx

وعليكم السلام-تفضل هذا هو الرابط الذى تم التعامل من قبل مع هذا الملف يمكنك تحميل الملف منه مرة اخرى وهو يعمل https://www.officena.net/ib/topic/92008-ماعرفت-كيف-احمي-ملفي-من-النسخ-وكيف-ينتحر/?tab=comments#comment-577543

جرب المرفق لعل فيه ما تريد (حسب فهمي للمسألة).... B2B.XLSX

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

السلام عليكم ورحمة الله تم تعديل معادلات التنسيقات الشرطية في العمودين A و B بحيث يتم مباشرة تلوين خلايا العمود A التي تحوي قيما غير موجودة في العمود B (الأصفر) وتلوين خلايا العمود B التي تحوي قيما غير موجودة في العمود A (الوردي أو لون آخر) دون الاعتماد على قيم خلايا العمودين E و F... بن علية حاجي تنسيق شرطى بناء على قيم.xlsx

اتفضل التعديل نسخة من تلوين لون خط الخليتان اذا تحقق الشرطان.xlsx

اتفضل جرب والشرح ان كان هذا ما تريد بعد التجربة وان كان هذا ما تريد لا تنسي الدعاء الوفير لاستاى الجليل ومعلمى القدير الاستاذ @jjafferr والله اهدانى هذا الكود فى يوم من الايام دون ان اطلبه حتى كنت اسال عن شئ وكتبت كود كبير جدا ومطول لاصل لمبتغاى بعد ان توصلت لاجابة على سؤالى والذى لم يكن له علاقة تقريبا بهذه الطريقة وبهذا الكود اهدانى اياه معلمى حتى لا يكون الامر شاقا على بكتابة الكثير من الاكواد لاصل لهذه النتيجة اسأل الله تعالى ان يرزقه عن كل حرف كتبه ليعلم به حسنه واسال الله تعالى ان يضاعفها بكرمه وجوده الى اضعافا لا تحصى ولا تعد يارب العالمين فتثقل ميزان اعماله فيترتقى اعلى درجات الجنان يارب العالمين شقق ومخازن ايجارات - Copy.accdb توضيح فقط لم ارد جلب البيانات اصلا مرة اخرى لاننى بالفعل املكها فى احد الجداول لماذا اجلبها وحمل القاعدة ببينات تتكرر من الاساس

هذه طريقة لاخفاء الاسم بعد اختياره من القائمة ..... جربها ComboBox (1).accdb

السلام عليكم سيدي الفاضل ، عاشت ايدك ، اكواد بسيطة ونتائج رائعة التغييرات اللي انا عملتها: 1. اذا كتبت شيء ، وغيرت رأيك ، فتستطيع ان تضغط على الزر Esc (Escape) ، وسوف يختفي النموذج الفرعي ، Private Sub text76_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then SubFrm.Visible = False Else SubFrm.Visible = True End If End Sub 2. اذا كتبت شيء ، فارتفاع النموذج الفرعي يطول ويقصر مع عدد السجلات الموجودة ، اكثر عدد هو 3 ، Private Sub text76_Change() On Error Resume Next Dim x As String SubFrm.Visible = True x = Me.text76.Text Me.Text11.Value = x Me.SubFrm.Requery 'تغيير ارتفاع النموذج الفرعي حسب عدد سجلاته Dim rst As DAO.Recordset Set rst = Me.SubFrm.Form.RecordsetClone rst.MoveLast RC = rst.RecordCount If RC > 3 Then Me.SubFrm.Height = Me.SubFrm!FldText.Height * 3 Else Me.SubFrm.Height = Me.SubFrm!FldText.Height * RC End If rst.Close: Set rst = Nothing End Sub 3. اذا كتبت شيء ، ونقرت على الاسم في النموذج الفرعي ، فسيتغير سجل النموذج الرئيسي حسب الاسم المختار ، وهنا فانت لست بحاجة الى زر البحث Private Sub FldText_Click() 'Forms!formS1.ITEM_NEM = Me.FldText Me.Parent.text76 = Forms!formS1!SubFrm.Form.FldText.Text 'اظهر نتيجة البحث Me.Parent.Form.Requery 'Me.Parent.text76.SetFocus Forms!formS1!SubFrm.Form.Visible = False End Sub جعفر 624.test.mdb.zip

تسلم ايدك استاذي الغالي جعفر تم حل المشكلة بنجاح مع بعض التعديل على الكود الذي وضعته كالتالي Forms!formS1!SubFrm.Form.FldText.Text حيث ان fromS1 هو النموذج الرئيسي و SubFrm هو النموذج الفرعي و FldText هو اسم الحقل في النموذج الفرعي بالمناسبة قمت باستعمال طريقتك الموضحة في الرابط "هدية: البحث عن اي جزء من الكلمة ، في اي عدد من الحقول" مع بعض التعديلات الطفيفة والحمد لله الامور ماشية تمام .. اشكرك جزيل الشكر على ماتقدمه تحياتي هذه التعديلات في الملف المرفق test.zip

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

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

السلام عليكم بثلاث خطوات : 1- اقرأ في الأساسيات : اساسيات البرمجة ( تحليل البيانات ) اساسيات أكسس ( تصميم الجداول ، الاستعلامات ، النماذج ، التقارير ) 2- ابدأ بعمل مشروعك يدويا بدون استخدام المعالج ( حاول ان يكون بسيطا _ مثلا : مكتبة منزلية _ او مستودع خاص ) و اعلم ان 50% من المشروع يكمن في تصميم الجداول ( لذا احرص على انشاء الجداول بالطريقة العلمية الصحيحة) 3- اذا واجهتك صعوبات ابحث عن الحلول في المنتديات المتخصصة

أخي الكريم أرجو اتباع قواعد المشاركة فى المنتدي و عدم توجيه السؤال الي شخص او أشخاص و أن يكون عنوان الموضوع دال علي محتواه ( أرجو مراجعة القواعد ) حسب ما فهمت أن الموضوع كله فى نموذج واحد أي لا يوجد نموذج فرعي لذلك أحد الحلول هو استخدام خاصية Filter للنموذج Private Sub Combo10_AfterUpdate() Me.Filter = "TblEmployee.country=Forms![TblEmployee]![Combo10] " Me.FilterOn = True End Sub مرفق المثال FilterByCombo.rar