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

جرب هذا الماكرو Sub Fil_combo() Dim k, col, arr(), i%: i = 1 For k = 1 To Sheets.Count col = Sheets(k).Tab.Color If col Then ReDim Preserve arr(1 To i) arr(i) = Sheets(k).Name i = i + 1 End If Next With Me.ComboBox1 .List = Split(Join(arr, ","), ",") .Value = .List(0) End With End Sub COMBO_fil.xlsm

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

السلام عليكم تم عمل المطلوب بمعادلة صفيف... في الملف المرفق. test - Copy.xlsx

الغالبية هناتعمل على اصدار اوفيس 2007 و 2010 قم بعمل نسخه بصيغة 2007 أو 2010 ليتم النظر بطلبك وبعد ذلك يمكنك تطبيق الحل على نسختك ::بالتوفيق::

السلام عليكم توجد العديد من البرامج الخاصة باسترجاع الملفات المحذوفة من الحاسوب منها (Recuva- Recovery My File) تحياتي

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

ممكن عملها اذا كان رقم 2020 ثابت لا يتغير في حدث بعد التحديث للحقل m p r نضع الكود التالي [Person_in_charge] = [Person_in_charge] & "/2020" اما اذان 2020 يرمز للعام فالافضل انشاء حقل مخفي في النموذج تكون قيمته =Year(Date()) والهدف من ذلك ان سجلات العام القادم تاخذ الملحق /2021 وهكذا للسنوات القادم ويكون الكود على النحو التالي [Person_in_charge] = [Person_in_charge] & "/" & [y_d] y_d اسم الحقل المخفي الخاصة العام يمكن الاستغناء عن الحقل المخفي عن طريق متغيير ولكن دائما الحل الاسهل اسرع في وصول المعلومة للمتلقي المثال مرفق PRODUCT21.mdb

تم العمل كما تريد الكود يلون الصفوف الغريبة اوتو ماتيكياً Option Explicit Sub test() Dim RgA As Range, RgC As Range Dim Find_rg As Range, Rgl As Range Dim Dic_Yes As Object Dim m%, x%, R%, arr Set RgA = Sheets(1).Range("A4", Range("A3").End(4)) Set RgC = Sheets(1).Range("C4", Range("C3").End(4)) '=========================== Set Rgl = Sheets(1).Range("L4").CurrentRegion R = Rgl.Rows.Count If R > 1 Then Rgl.Offset(1).Resize(R - 1).Clear End If '============================ Set Dic_Yes = CreateObject("Scripting.Dictionary") For x = 1 To RgA.Rows.Count Set Find_rg = RgC.Find(RgA.Cells(x), lookat:=1) If Not Find_rg Is Nothing Then R = Find_rg.Row arr = Sheets(1).Cells(R, 3).Resize(, 8).Value arr = Application.Transpose(Application.Transpose(arr)) Dic_Yes.Add m, Join(arr, "*") m = m + 1 End If Next For x = 0 To Dic_Yes.Count - 1 Range("L" & x + 4).Resize(, 8).Value = Split(Dic_Yes.Item(x), "*") Next x = x + 4 For m = 1 To RgC.Rows.Count If IsError(Application.Match(RgC.Cells(m), RgA, 0)) Then RgC.Cells(m).Resize(, 8).Copy Cells(x, "L") Cells(x, "L").Resize(, 8).Interior.Color = RGB(0, 204, 255) x = x + 1 End If Next With Range("l4").Resize(x - 4, 8) .Value = .Value .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 14 .InsertIndent 1 End With Set RgA = Nothing: Set RgC = Nothing Set Find_rg = Nothing: Set Rgl = Nothing Set Dic_Yes = Nothing: Erase arr End Sub Farz1.xlsm

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

استعراض نتائج كل شهر من هذة السنوات باستخدام القائمة المنسدلة

ممكن هذا الشيء ان يكون المطلوب my_sum.xlsx

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

السلام عليكم الأخوات الكريمات، الإخوة الكرام هذا المورد الرقمي يشغل على الحاسب بعد فك الضغط عنه وهو مورد رقمي بالأوتوبلاي كان ثمرة دورة تكوينية حول برنامج الأتوبلاي كان لي شرف الإشراف عليها وقد مزجنا في هذا البرنامج بين تقنيات الأتوبلاي و استغلال تقنيات الإكسيل في ميداننا التعليمي خاصة الشق المتعلق باستثمار النقط المورد تفاعلي عبر الترحيب باسم المستخدم وتوديعه وشكره باسمه في نافذة الترحيب يظهر الوقت والتاريخ الحالي المورد يوفر السؤال/ المهمة ووثيقة الإشتغال و الجواب للمقارنة بما أنجزه المستخدم لتتحقق الإفادة بالاضافة لمعادلات إكسيل وشرحها وكتاب رائع حول تعلم VBa بالعربية البرنامج عربي إن ظهرت لكم النوافذ بحروف غريبة ساتفاعل معكم لحل المشكلة التي سببها أن حاسوبكم لايدعم البرامج العربية أتقاسم معكم موردي الرقمي ومورد أحد الإخوة المتوفقين في إنجاز هذا المورد ولا نسألكم إلا الدعاء الصالح بظهر الغيب لي وللأخ عبد الالاه: التحميل من هنا: مورد هشام: https://drive.google.com/file/d/13JZ...ew?usp=sharing مورد عبد الالاه: https://drive.google.com/open?id=1mI...DbKroZoMJcpbey والله ولي التوفيق

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

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

كل الشكر للاخ ابو بسمله وكذلك الشكر موصول للاخ صلاح

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

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

تعديل بسيط على كود الاخ صلاح جزاه الله خيرا بملاحظه الاخ السائل لعمل تحديث للنموذج الفرعى بعد الادخال عند عدم الادخال والضغط عالزر سوف تظهر لك الرساله عند الادخال والضغط عالزر سيتم الانتقال لسجل جديد جزاه الله خيرا الاخ @صلاح جبر Private Sub Command24_Click() Me.Child12.Form.Requery If Me.tob = 0 Then MsgBox "ادخل رقم السائق", vbCritical, "صلاح جبر" Me.Child12.SetFocus Else DoCmd.GoToRecord , , acNewRec End If End Sub تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق

لن تستطسع فتح الملف باصدار 2010 قم بفتح الملف عن طريق اصدار 2016 بعد ذلك قم بعمل نسخه عن طريق حفظ باسم واختر الاصدار من القائمة التي ستظهر لك ::بالتوفيق::

اخى الفاضل انظر الى الجدول ثم الى الاستعلام عند النقر على الاستعلام سيطلب منك ادخال رقم الفنى ادخل رقم 50 ، 100، 200 ارقام الفنيين سيت فتح الاستعلام على الرقم الذى ادخلته نصيحه من اخ مبتدء اجعل دائما اسماء الحقول والجداول والاستعلامات بالانجليزى حتى لو كتبت مثلا كتاب Ktab حتى لا تتعب فى كتابه الكود ولا تجعل بين الاسماء مسافات اجعل البادئه حرف كبير مثلا LastName او Last_Name تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق 16(1).accdb

أتمنى لكم التوفيق أخي العزيز. وأعتذر لعدم تمكني من مساعدتكم.

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

هذا الكود ولا لزوم للخلقات التكرارية Private Sub ToggleButton1_Click() If ToggleButton1 = True Then Call HideBlankRows: ToggleButton1.Caption = "Show_All" Else Call Show_all: ToggleButton1.Caption = "Filter_Me" End If End Sub '++++++++++++++++++++++++++++++++++ Sub HideBlankRows() Dim r%, My_RG As Range Set My_RG = Range("A11").CurrentRegion r = My_RG.Rows.Count My_RG.Offset(1).Resize(r - 1).AutoFilter 6, _ Criteria1:="<=" & Range("k2") End Sub '+++++++++++++++++++++++++ Sub Show_all() If ActiveSheet.AutoFilterMode Then Range("A10").CurrentRegion.AutoFilter End If End Sub الملف مرفق FILTR_No_Filter.xlsm

ممتاز اخي صلاح هذا المطلوب ....لاكن كيف الطريقه هل ماكرو ام كود حسب ما رايت انك عملت حساب لعدد السجلات الموجودين في النموذج الفرعي فاذا كانت القيمه صفر تجي الرساله واذا كانت معبئه فالامور في السليم ولاكن اين وضعت هذا الكود If Me.tob = 0 Then MsgBox "ÇÏÎá ÑÞã ÇáÓÇÆÞ", vbCritical, "ÕáÇÍ ÌÈÑ" Me.Child12.SetFocus Else DoCmd.GoToRecord , , acNewRec End If لم اري حدثا في خصائص الحقول او النماذج جزيت خيرا

السلام عليكم بعد اذن الاخوة الاعزاء انظر للملفين المرفقين اتمنى ان يكون المطلوب تحياتي استيراد.rar استيراد وحذف وتصدير اكسيل.rar

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

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

هاذي حق يمن سوفت ؟؟

لأخي الحبيب @خالد بشير قوانين المنتدى تمنع مثل هذا التصرف راجع قوانين المنتدى أخي الكريم 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

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

السلام عليكم بعد اذن اخي محمد هذه قكرةرائعىة انه يخصص الشخض قاعدة بيانات فارعة وليس سيرفر لارشفة الجداول المهمة في جميع قواعد البيانات لنفرض فاعدةالبيانات المراد ترحيل الجدولayman1 والقاعدة الفارغة archieve Dim db As DAO.Database Dim blnTrans As Boolean Dim strSQL As String Dim strPath As String Dim strDb As String Dim strDateCriteria As String ' On Error GoTo ErrorHandler strPath = "C:\AYMAN71\" strDb = "ayman1.accdb" strDateCriteria = _ "BETWEEN #1/1/2000# AND #12/31/2022#;" DBEngine.BeginTrans blnTrans = True Set db = OpenDatabase(strPath & strDb) ' نسخ جدول orders ' وتصديره ثم حذفه strSQL = _ "SELECT * INTO origin IN " & _ Chr(34) & strPath & strDb & Chr(34) & _ " FROM Orders WHERE Orders.OrderDate " & _ strDateCriteria db.Execute strSQL, dbFailOnError ' تاكبد If MsgBox("Click OK if you want to archive " _ & db.RecordsAffected & _ " records.", vbOKCancel + _ vbQuestion + vbDefaultButton2, _ "Proceed?") = vbOK Then DBEngine.CommitTrans DoCmd.TransferDatabase acImport, "Microsoft Access", "C:\ayman71\ayman1.accdb", acTable, "origin", "archive" db.TableDefs.Delete ("origin") Application.RefreshDatabaseWindow Else If blnTrans Then DBEngine.Rollback End If If db.RecordsAffected = 0 Then DBEngine.Rollback MsgBox "لا حركات " & _ "with the specified criteria.", _ vbInformation + vbOKOnly, _ "Records not found" End If Cleanup: Set db = Nothing Exit Sub

اضافة أمر حفظ سجل قبل تشغيل SQL DoCmd.RunCommand acCmdSaveRecord لازم اضافة هذا امر Edit123.accdb

كان من المفروض ان تذكر المشاركة الثّانية رأساُ لعدم اهدار الوقت باشياء غير مدروسة الكود Option Explicit Sub test() Dim RgA As Range, RgC As Range Dim Find_rg As Range, Rgl As Range Dim Dic_Yes As Object Dim m%, x%, R%, arr Set RgA = Sheets(1).Range("A4", Range("A3").End(4)) Set RgC = Sheets(1).Range("C4", Range("C3").End(4)) '=========================== Set Rgl = Sheets(1).Range("L4").CurrentRegion R = Rgl.Rows.Count If R > 1 Then Rgl.Offset(1).Resize(R - 1).Clear End If '============================ Set Dic_Yes = CreateObject("Scripting.Dictionary") For x = 1 To RgA.Rows.Count Set Find_rg = RgC.Find(RgA.Cells(x), lookat:=1) If Not Find_rg Is Nothing Then R = Find_rg.Row arr = Sheets(1).Cells(R, 3).Resize(, 8).Value arr = Application.Transpose(Application.Transpose(arr)) Dic_Yes.Add m, Join(arr, "*") m = m + 1 End If Next For x = 0 To Dic_Yes.Count - 1 Range("L" & x + 4).Resize(, 8).Value = Split(Dic_Yes.Item(x), "*") Next x = x + 4 For m = 1 To RgC.Rows.Count If RgC.Cells(m).Interior.ColorIndex > 0 Then RgC.Cells(m).Resize(, 8).Copy Cells(x, "L") x = x + 1 End If Next With Range("l4").Resize(x - 4, 8) .Value = .Value .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 14 .InsertIndent 1 End With Set RgA = Nothing: Set RgC = Nothing Set Find_rg = Nothing: Set Rgl = Nothing Set Dic_Yes = Nothing: Erase arr End Sub الملف Farz.xlsm

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

بعد اذن الاخ علي جرب هذا الكود Option Explicit Sub Salim() Dim My_rg1 As Range, RO%, m%, n%, x% Dim Arr1, Ful_arr(), Arr2() Set My_rg1 = Range(Sheets(1).Range("A4"), Sheets(1).Range("A4").End(4)) Arr1 = Application.Transpose(My_rg1) RO = Sheets(2).Cells(Rows.Count, 1).End(3).Row Sheets(2).Range("C4").CurrentRegion.Clear m = 1: n = 1 For x = 4 To RO If IsError(Application.Match(Sheets(2).Range("A" & x), Arr1, 0)) Then ReDim Preserve Arr2(1 To m) Arr2(m) = Sheets(2).Range("A" & x).Value m = m + 1 Else ReDim Preserve Ful_arr(1 To n) Ful_arr(n) = Sheets(2).Range("A" & x).Value n = n + 1 End If Next With Sheets(2).Range("C4").Resize(n - 1) .Value = Application.Transpose(Ful_arr) .Borders.LineStyle = 1 .Interior.ColorIndex = 20 .Font.Bold = True .Font.Size = 14 .InsertIndent 1 If m <> 1 Then With .Offset(n - 1).Resize(m - 1) .Value = Application.Transpose(Arr2) .Borders.LineStyle = 1 .Interior.ColorIndex = 19 .Font.Bold = True .Font.Size = 14 .InsertIndent 1 End With End If End With Erase Arr1: Erase Ful_arr(): Erase Arr2() End Sub الملف مرفق Tartib.xlsm

تفضل محاولة استيراد.rar

وعليكم السلام - تفضل الم تطلع على الملف تم تنفيذ المطلوب بهذا الكود Sub arrange() Sheet1.Activate Columns("A:A").Select Selection.Copy Sheet2.Activate Columns("b:b").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub ترتيب بيانات الصفوف حسب القائمة الأساسية.xlsm

أستاذ sabry fahmy أين الضغط على الإعجاب ؟!💙

عليك السلام ورحمة الله وبركاته بعد إذن الأستاذ khalf كان لزامًا عليك استخدام خاصية البحث في المنتدى

جرب هذا الملف ATM_BANK.xlsx

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

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

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

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

وهناك حل افضل قليلا وهو ربط غلق البرنامج بحدوث Screen Saver فعليا وربما كان ذللك معبرا فعليا عن المستخدم كف عن استخدام البرنامج وكذلك ان ضبط screen Saver معبر عن رغبة المستخدم بدلا من تضايقه من غلق البرنامج قصرا عنه الخطوات: 1-ندخل Module ونكتب فيه ننقل فيه الأكود الاتية 'http://www.littleguru.com '================================= Public Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) Public Declare Function GetWindowText& Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) Private strAppTitle As String Private lngHwnd As Long Public Function IsRunning&(strTitle As String) lngHwnd = 0 strAppTitle = strTitle EnumWindows AddressOf EnumWinProc, 0 If lngHwnd <> 0 Then IsRunning = lngHwnd Else IsRunning = 0 End If End Function Private Function EnumWinProc&(ByVal lhWnd As Long, ByVal lParam As Long) Dim WinTitleBuf As String * 255 Dim WinTitle As String GetWindowText lhWnd, WinTitleBuf, 255 WinTitle = StripNulls(WinTitleBuf) If InStr(WinTitle, strAppTitle) <> 0 Then lngHwnd = lhWnd EnumWinProc = False Exit Function End If EnumWinProc = True End Function Private Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = OriginalStr End Function 2- فى النموذج نضع الفاصل الزمنى المناسب بالمللى ثانية وهذا الفاصل لا يستخدم لغلق البرنامج بل كل فاصل زمنى يتم اختبار ما إذا كان الscreen Saver يعمل فإذا كان يعمل يقوم بغلق البرنامج ويتم نسخ هذا الكود فى حدث OnTimer للنموذج : Private Sub Form_Timer() Dim strApp As String strApp = "Screen Saver" If IsRunning(strApp) > 0 Then Application.Quit End If End Sub وما زال يعيبها أن تتم من خلال نموذج ولا يوجد حدث فى Application لكى يتم ربط الدالة به ..... مع تحياتى وخالص الشكر للاستاذ أبى أفنان على هديته أكواد خاصة بالكسس

فى الحقيقة الطريقة السابقة تغلق قاعدة البينات اتوماتيكيا بعد 10000 مللى ثانية ولكن ليس هذا هو المطلوب تماما وذلك لأن قاعدة البيانات ستغلق حتى لو كان المستخدم يستخدم الفأرة ولوحة المفاتيح أى الغلق يتم دونما شرط او قيد يكون تعديلها بالطريقة الاتية 1-ندخل Module ونكتب فيه الجملة الاتية Global SumofEvents1 As Integer, SumofEvents2 As Integer 2- فى النموذج يتم عمل الاتى خاصية Timer Interavels =180000 (milli-Second) تكتب هذه الدوال فى كود النموذج Private Sub Form_KeyPress(KeyAscii As Integer) If SumofEvents1 > 32000 Then SumofEvents1 = -32000 SumofEvents1 = SumofEvents1 + 1 End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If SumofEvents1 > 32000 Then SumofEvents1 = -32000 SumofEvents1 = SumofEvents1 + 1 End Sub Private Sub Form_Timer() If SumofEvents1 = SumofEvents2 Then Application.Quit Else SumofEvents2 = SumofEvents1 End If End Sub والفكرة أنه يتم تعريف متغيريين ونقوم بيادة 1على المتغير الأول عند حدوث أى حدث - يمكن تكرار S Sub Form_MouseMove فى كل الأحداث المطلوب ان تعبر عن ان المستخدم متواجد أمام الكمبيوتر كل فاصل زمنى تقوم Sub Form_Timer بتخزين القيمة عند هذا الفاصل غى المتغير وكل فاصل زمنى تقوم باختبار المتغييرن ومعنى تساويهما أنه لم يتم أى حدث بين الفاصلين وهنا نغلق قاعدة البينات العيوب: 1-يجب تكرار الدوال لكل مقاطع النموذج حيث أن تحرك الماوس على مقطع Detail بسسب الحدث Detail_MouseMove وهكذا 2- فى حالة عمل Minemize للنموذج لن يسجل أى أحداث للماوس والكيبورد مما قد يؤدى ألى غلق قاعدة البيانات بينما المستعمل يقوم بأحداث على مكان أخر 3-أيضا فى حالة فتح نموذج الى هذا النموذج بمساحة أكبر يستقبل النموذج الثانى كل الأحداث وتؤدى إلى النتيجة السابقة

أبدا مش صعب ولا حاجة أفتح النموذج في وضع التصميم ثم في قائمة حدث ستجد خاصية: الفاصل الزمني لعداد الوقت أكتب فيه مثلا : 1000000طبعا هذي القيمة بالملي سكند يعني 10 دقايق . يعد كذه تجد في القائمة :عند عداد الوقت : أكتب مثلا Quit ======================== أحفظ النوذج وشغله سوف يضل مفتوح لمدة 10 دقائق وبعدها يقفل البرنامج , تصلح هذي الطريقة عندما يكون البرنامج على شبكة ويكون أحد المستخدمات فاتحة البرنامج ونسته مفتوح مثلا . تحياتي

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

أحببت أن أطلعكم على الاصل وهو أكثر من 600 كود في الفيجول أكواد v.6.rar