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

السلام عليكم للاخوة المبتدئين طريقة اخراج او طباعة تقرير بنظام (بي دي اف ) Pdf

السلام عليكم تواجه كثيراً من مستخدمي إكسل مشكلة تشفير الكتابة العربية في الملفات وخاصة تلك المصدرة من الأجهزة والبرامج الأخرى كجهاز البصمة أو الملفات المحملة من الإنترنت أقدم لكم هذا الكود الذي كتبته بعد بحث في موضوع اليونيكود خاصة أني سابقاً قد عانيت من المشكلة و الحلول البديلة تسمح بمعرفة المحتوى دون القدرة على تحويل الملف بالكامل. ملاحظة : يفضل نسخ الملف المشفر قبل إجراء التحويل عليه. a Code shows invalid/ decrypted characters in Excel properly والحمد لله الذي بنعمته تتم الصالحات و صلى الله على سيدنا محمد وعلى آله وصحبه أجمعين وسلم تسليماً كثيراً. عند فتح الملف هنا زر بالنقر عليه تفتح نافذة لاختيار الملف المطلوب ثم مربع حوار لكتابة اسم الورقة ثم مربع حوار اختيار المجال المراد تغييره عن طريق التحديد. الفانكشن في البداية يمكن استدعاؤها كدالة من دوال إكسل ضمن ورقة البيانات يكفي لذلك = InStead(YourText or Cell Address) Public Function InStead(T1 As String) ' Created by Khalf Officena Forums 20/02/2020 ' www.officena.net ' Hamdi Edlbi ' This Code for Showing Arabic Characters Properly In Excel Dim w As Integer w = Len(T1) For X = 1 To w T2 = Mid(T1, X, 1) T3 = AscW(T2) T4 = Chr(T3) T5 = T5 & T4 Next X InStead = T5 End Function Sub InSteadAll() ' This Sub For Call the Function In The Current Sheet On Error Resume Next Dim C As Range For Each C In Selection C.Value = InStead(C.Value) Next End Sub Sub ChooseRange() 'Choose the Range Dim rng As Range Set rng = Application.InputBox("Select The Range", "Decryption Characters", , , , , , 8) Application.Goto rng ' Call The Sub InSteadAll Call InSteadAll End Sub Sub OpenWorkbook() 'Apply The Code to Another Workbook On Error Resume Next Dim strFile As String Dim X As String strFile = Application.GetOpenFilename() Workbooks.Open (strFile) ' These Followed Couple of Lines are Optional In Case You Need to Get Specific Sheet X = Application.InputBox("Select The Sheet", "Decryption Characters", , , , , , 2) Sheets(X).Activate Call ChooseRange End Sub Decryption_Invalid_Characters.xls

السلام عليكم و رحمة الله و بركاته أزرار متحركة و منزلقة قد تفيد أحد الأخوة في مشاريعهم أزرار متحركة.accdb

السلام عليكم معكم ساجدة العزاوي من العراق اول مشاركة لي في المنتدى فديو مميز سهل رائع لاقى صدى واسع ينفع للكل للمدارس لدوائر الدولة للقطاع الخاص فديو عملته بـ 8 اجزاء ولما شفت كثيرين استفادوا منه عملت فديوين بعنوان في الاكسل متعة وسعادة وفرح فاصبح 10 اجزاء وساكمله باجزاء اخرى ... لانه رائع ومميز وسريع هناك من يريد تنسيبه لنفسه اترككم مع الفديو بحث بالاسم في TEXTBOX فيتم الفلترة الى LISTBOX وثم الى TEXTBOXES اكسل ساجدة العزاوي

ممكن ذلك بهذا التعديل على الماكرو Option Explicit Sub Copy_As_you_Like1() Dim S As Worksheet, sec As Worksheet Dim i% Dim Last%, m%, k%, Howmay_row Set S = Sheets("Source"): Set sec = Sheets("second_sh") sec.Range("A3").CurrentRegion.Clear m = S.Range("F6"): Howmay_row = S.Range("F7") Last = S.Cells(Rows.Count, 2).End(3).Row m = 3: k = 2 For i = 3 To Last sec.Cells(m, k) = S.Cells(i, 3) sec.Cells(m, k + 1) = S.Cells(i, 2) m = m + 1 If m Mod (Howmay_row + 3) = 0 Then m = 3: k = k + 2 End If Next With sec.Range("B3").CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 End With End Sub

وعليكم السلام-يمكنك تطويع هذا الكود Option Explicit Option Base 1 Sub Wsh_CopyTo_NewWbk() Dim aWsh As Variant aWsh = [{"Sheet1","Wsh1";"Sheet2","Wsh2"}] Dim aWshSrc(2) As Worksheet Dim wbk As Workbook, wsh As Worksheet Dim vItm As Variant, b As Byte Rem Set Worksheet Array With ThisWorkbook For b = 1 To UBound(aWsh) .Worksheets(aWsh(b, 1)).Unprotect Password:=aWsh(b, 2) Set aWshSrc(b) = .Worksheets(aWsh(b, 1)) Next: End With Rem Add New Workbook Set wbk = Workbooks.Add With wbk Rem Delete All Worksheets but One Application.DisplayAlerts = False For Each wsh In .Worksheets With wsh If .Index = 1 Then .Name = "!DELETE" Else .Delete End With: Next Application.DisplayAlerts = True Rem Copy Worksheets For Each vItm In aWshSrc vItm.Copy After:=Sheets(.Sheets.Count) Set wsh = .Sheets(.Sheets.Count) wsh.UsedRange.Value = wsh.UsedRange.Value2 Next Rem Delete Reamining Worksheet Application.DisplayAlerts = False .Worksheets("!DELETE").Delete Application.DisplayAlerts = True End With End Sub

جرب هذا الملف هناك خياران الصفحة Targ والصفحة second_sh لا ادري ايهما تريد Copy_Many_times.xlsm

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

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

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

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

جدا جدا اشكرك استاذنا الكبير ربي يحفظك

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

السلام عليكم هل هذا ماطلبت اعلمنا رجاءا Database2.rar

شرحته بفديو ونشرت الفديو من يومين بالمنتدى تابعه

سبب المشكلة هو وجود علامتَي تشكيل متجاورتين بعد كلّ "لأ" أو "لإ". فبدلاً من كتابة أول تشكيل بعد اللام وثاني تشكيل بعد الألف، وُضعت علامتا التشكيل بعد الألف. وهذا ما يجعل الوورد يضع التشكيل الثاني بشكل مستقل لأن وجوده بعد تشكيل سابق لا يجوز. (مثلاً، في حالة كلمة "الإنسان"، هناك كسرة بعد سكون!) إليك هذا الحلّ: - في البحث والاستبدال انسخ وألصق ما يلي في مربع البحث: ل([إأ])([ًٌٍَُِْ])([ًٌٍَُِْ]) - في مربع الاستبدال انسخ وألصق ما يلي: ل\2\1\3 - انقر على زر "المزيد" واختر "استخدام حروف البدل" وأيضاً "مطابقة همزة الألف". - اضغط على زرّ "استبدال" وانظر إن كانت الأخطاء تُصحّح. يمكنك مواصلة الضغط على زرّ "استبدال" لمتابعة مراقبة التعديلات التي تُجرى، أو الضغط على "استبدال الكل" للانتهاء من الأمر بسرعة.

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

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

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

السلام عليكم تفضل ارجو ان يكون طلبك ملاحظة : زر الامر في نموذج (1) هو لحساب العمولة لكل عامل مع عدد العمال اذا لم تكن محسوبة بالاضافة الى انه سيحسب تلقائيا عند اضافة سجل جديد ام نموذج 2 فهو لحساب العمولة الكلية للعامل Root100.rar

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

أحسنت استاذ خلف جزاك الله كل خير

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

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

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

السلام عليكم ورحمة الله استخدم الكود التالى Sub DistGroups() Dim ws As Worksheet, LR As Long Dim i As Integer, j As Integer Dim n As Integer, x As Integer, y As Integer Dim p As Integer, s As Integer Set ws = Sheets("ورقة1") Application.ScreenUpdating = False Range("F2:I" & Range("F" & Rows.Count).End(xlUp).Row + 1).ClearContents LR = ws.Range("B" & Rows.Count).End(xlUp).Row x = WorksheetFunction.CountA(ws.Range("B2:B" & LR)) n = ws.Range("D2").Value y = Int(x / n) z = x Mod n If z > 0 Then n = n + 1 Else n = n End If p = 2 Do While p <= LR For i = 1 To n For j = 1 To y s = j + ((i - 1) * y) + 1 If p = s Then ws.Cells(j + 1, i + 5) = ws.Cells(p, 2) End If Next Next p = p + 1 Loop Application.ScreenUpdating = True End Sub

بشكل اكثر اختصاراً Sub My_code() Dim i% i = 2 Do Until Range("B" & i) = vbNullString With Range("B" & i) .Interior.ColorIndex = _ IIf(.Value > .Offset(, 1), 3, xlNone) End With i = i + 1 Loop End Sub

بعد اذن الاستاذ نبيل عبد الهادي واثراء للموضوع جرب المرفق اخفاء اوراق العمل بناء على معلومة في خلية.xlsm

السلام عليكم مشاركه مع اخى @عبد اللطيف سلوم هل هذا ما تريد اذا كان فيجب عند ادخال رصيد التسديد بالسالب مع ملاحظه باننا قمنا بالحساب بناء على رقم العميل ورقم الايصال فهذا ما تعلمته وما زلت اتعلم والله اعلى واعلم وجزاهم الله خيرا اخواننا واساتذتنا الذين تعلمنا ونتعلم منهم كل يوم ولعل احد اخواننا واساتذتنا لديه طريقه افضل فيشاركنا فنتلعم طرق اخرى Expr1: Nz(DSum("[daen]";"sdad";"[ID]=" & [ID] & "And [num]<=" & [num]);0) تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق ادخال_بالكود_تراكمى.accdb

السلام عليكم اكتب او اختر من القائمة المنسدلة في الخلية m1 اخفاء اوراق العمل بناء على معلومة في خلية.xlsm

تفضل اخي لقد وضعت كود بسيط اكتب الارقام التي تريدها وسيتغير الى السالب تلقائيا أرقام سالبة.xls

السلام عليكم اخى الفاضل هل هذا ما تريد ؟ بعد اختيار التاريخ سيتم تحديث الرقم جرب ووافنا بالنتيجه واعذرنى عالتقصير تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق 3ادخال_بالكود(1).accdb

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

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

المنتدى نور بوجودك اختنا الفاضلة ساجدة وانا ايضا من المتابعين لاعمالك الابداعية

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

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

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

اذا كان التاريخ المطلوب تحديد الاحد السابق و التالي له موجود فى الخلية D3 كما فى المثال المرفق ( الخلايا باللون الاصفر) معادلة الاحد السابق تكون: =IF(D3="","",D3-MOD(D3-1,7)) و معادلة الأحد التالي تكون: =IF(D3="","",D3+7-MOD(D3-1,7)) و طبعا يمكن تغيير المعادلة لترجع اي يوم اخر مرفق المثال للسهولة Officena Sundays.xlsx

السلام عليكم أخي الكريم ستجد بالملف المرفق بعض المعادلات المساعدة في الأعمدة من K إلي BP وبيانها كالتالي: السطر الأول باللون الأزرق يعبر عن رقم الشهر العربي في حال يساوي 9 يعني هذا سيوافق رمضان السطر الثاني حساب بفارق 4 شهور حسب الموجود بالخلية G5 وإذا تغيرت المدة في المستقبل ، فقط غير تلك الخلية السطر الثالث يقر التاريخ بعد مراجعة أنه لايكون الشهر رمضان ولا ديسمبر السطر الرابع لابد أن تملؤه كلما قبضت ربحية السهم أو الككوبون ويمكنك من كتابة شيء إلا "نعم" أو "لا" *** إذا ذهبت بالماوس لليمين ستجد أن التاريخ 11/02/2027 سيوافق رمضان وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وكذلك التاريخ 11/11/2035 سيوافق رمضان وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وكذلك التاريخ 11/12/2036 سيوافق ديسمبر وبالتلي ستجد السطر السفلي يتعدل أوتوماتيكيا وأخيرا الخلية التي بها التنبيه ، جعلت لون الفونط أبيض لكي لا يظهر إلا إذا كان باقي علي الموعد يوم أو تجاوزه ولم تعلم عليه ب "نعم" ، سيظهر باللون الأحمر تستطيع تغيير محتوي خلية ناريخ اليوم (E2) يدويا كأنه يوم واحد قبل الإستحقاق لتري النتيجة ثم تعيدها مرة أخري تفضل وأخبرني الاسهم.xls

ربما يكون الحل Result.xlsx

السلام عليكم اضافة الى ماتفضلوا به الاخوان هنا مثالين اخرين عن اعادة الترقيم بصورة تلقائية للاخوان بالموقع تحياتي db1.rar اعادة الرتقيم التلقائي بالاكسس.rar

حرب هذا الماكرو Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False Dim A As Worksheet Dim B As Worksheet Set A = Sheets("ALL_STD") Set B = Sheets("B") Dim col%, r, x, LB LB = B.Cells(Rows.Count, "B").End(3).Row If LB < 5 Then LB = 5 B.Range("a5").Resize(LB - 4, 6).Clear Dim my_clas$: my_clas = B.Range("e2") Dim my_mad$: my_mad = B.Range("K2").Value If my_clas = "" Or my_mad = "" Then GoTo Exit_Sub col = A.Rows(1).Find(my_clas, lookat:=1).Column r = A.Columns(1).Find(my_mad, lookat:=1).Row x = Application.CountIf(A.Columns(1), my_mad) B.Range("b5").Resize(x).Value = _ A.Cells(r, 2).Resize(x).Value B.Range("c5").Resize(x, 3).Value = _ A.Cells(r, col).Resize(x, 3).Value With B.Range("A5").Resize(LB - 4, 6) .Columns(1).Formula = "=if(B5="""","""",max($A$4:a4)+1)" .Columns(1).Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns(6).Formula = "=RANK(E5,$E$5:$E$29,0)+COUNTIF($E5:E$5,E5)" .Value = .Value .Font.Size = 26 .Font.Bold = True .InsertIndent 1 End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students.xlsm

السلام عليكم ورحمة الله وبركاته كل عام وأنتم جمبعا بخير ونسأل الله العظيم رب العرش العظيم أن يجعل هذا العام الميلادى الجديد خير وبركة علينا وعلى مصرنا الحبيبة وحفظها من كل سوء وبهذه المناسبة أقدم لكم آخر تحديثات برنامج كنوز ـ للمرحلة الابتدائية ( الروابط آخر المنشور ) ----------------------------- وأهم ما جاء بالتعديلات : 1 ـ إزالة جبر الكسور فى مجموع كل مادة على حده ، والابقاء على جبر الكسر فقط فى المجموع الكلى نصف العام و آخر العام 2 ـ تصحيح خطأ فى الاحصاء للطالب الغائب ( غ ) 3 ـ بعض خلايا الرصد فى مادة النشاط الاختيارى كانت لا تقبل قيمة أكبر من 70 درجة .. تم معالجة ذلك 4 ـ وضع تنويه بدرجة الطالب الذى لم يحصل على ثلث الدرجة فى التحريرى وجعل لون الخط أحمر تلقائيا لتنبيه مسئول الكنترول 5 ـ تحميل البرنامج به كل الصفوف ( مجلد يحتوى على الصفين الثانى والثالث ـ مجلد آخر يحتوى على الصف الرابع والخامس والسادس ) -------------------------------- واتمنى أت تقبلوا عذرى فى كثرة التحديثات على البرنامج ولكن هذا للصالح العام وللوصول بالبرنامج لأعلى دقة ممكنة بفضل الله أولا ، ثم بفضل مقترحاتكم وتوجيهاتكم -------------------------- وأخير ا روابط تحديث البرنامج بتاريخ اليوم 1/1/2019 م الصفوف : الرابع ـ الخامس ـ السادس 1/1/2019 https://up.top4top.net/downloadf-109565ex21-rar.html الصفوف : الثانى ـ الثالث 1/1/2019 https://up.top4top.net/downloadf-10951uvyc1-rar.html منقول

يا شباب ، عليكم بالبحث في المنتدى ، لتحصلوا على المطلوب البرنامج موجود على سيرفر المنتدى ، هنا: https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=139629 وبرنامج العطاء للتقسيط ، هنا: . جعفر

السلام عليكم اخى بن عليه حل ممتاز اخى ahmed00 هذا حل ثانى ومش ها تصدق عنيك باستخدام نفس دالتك المفضلة VLOOKUP وانت تعلم ان الدالة VLOOKUP تبخث عن قيمة واحد فقط والفكرة هى دمج شرطينك الى شرط واحد حتى تستطيع VLOOKUP ان تقبض عليها دمجت لك الشرطين فى B2 و C2 ووضعت الناتج فى A1 واستخدمت الصيغة (VLOOKUP(H6&I6;A5:E53;5;FALSE= اتمنى وضوح الفكرة تقبلوا تحياتى A Q ID.rar

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

السلام عليكم ورحمة الله وبركاته نفرض أنك تشتغل على نموذج بصورة شبه يوميه وتريد عندما تفتح النموذج أن يعود بك إلى أخر سجل قمت بإدخاله أو تعديله . المثال التالي يحل المشكله ان شاء الله وهو يعتمد على نموذج يحتوي على حقل ترقيم تلقائي فريد باسم ( CustomerID ) الشـــرح:- أولاً : أنشىء جدول باسم "tblSys" يتكون من الثلاث حقول التالية : Variable (حقل نصي حجمه 20 حرف) Value (حقل نص حجمه 80 حرف) Description (حقل نص حجمه 255 حرف) ثانياً: ضع الكود التالي في حدث عند إلغاء التحميل للنموذج المراد إستخدامه Sub Form_Unload (Cancel As Integer) Dim rs As DAO.Recordset If Not IsNull(Me.CustomerID) Then Set rs = CurrentDb().OpenRecordset("tblSys", dbOpenDynaset) With rs .FindFirst "[Variable] = 'CustomerIDLast'" If .NoMatch Then .AddNew ![Variable] = "CustomerIDLast" ![Value] = Me.CustomerID ![Description] = "Last customerID, for form " & Me.Name .Update Else .Edit ![Value] = Me.CustomerID .Update End If End With rs.Close End If Set rs = Nothing End Sub ثالثاً: ضع الكود التالي في حدث عند التحميل للنموذج المراد إستخدامه Sub Form_Load() Dim varID As Variant varID = DLookup("Value", "tblSys", "[Variable] = 'CustomerIDLast'") If IsNumeric(varID) Then With Me.RecordsetClone .FindFirst "[CustomerID] = " & varID If Not .NoMatch Then Me.Bookmark = .Bookmark End If End With End If End Sub ملاحظة: أضف المرجع DAO 3.6 إلى قائمة المراجع لديك في القاعدة لكي تعمل القاعدة بالشكل المطلوب. للإستيضاح مرفق مثال على ذلك. والله الموفق (المرجع أحد المواقع الأجنبية) Last_update_Recorde.zip