ابوخليل

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

وعليكم السلام DoCmd.RunCommand acCmdAppMinimize dbx.rar

Private Sub Form_Current() If Me.fldate < Date Then Me.AllowEdits = False Else Me.AllowEdits = True End If End Sub باعتبار flddate هو حقل التاريخ في النموذج db2.rar

الحمد لله وبارك الله فيك الله يسعدك يابوعبدالله ما يفوت عليك شي

Option Compare Database Dim DBOld As String Dim DBNew As String Private Sub Form_Close() On Error Resume Next Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB OldFile = DBOld DBwithEXT = Dir(OldFile) DBwithoutEXT = left(DBwithEXT, Len(DBwithEXT) - 4) Application.SetOption "Use Hijri Calendar", False NewFile = DBNew & "\" & Format(Now, "yyyymmddhhnnss") & ".mdb" CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub End Sub Private Sub Form_Load() DBOld = CurrentProject.Path & "\db2.mdb" DBNew = CurrentProject.Path & "\tst\" Call zerNc End Sub Sub delfiles() Dim strFldr As String Dim strFile As String Dim FileToGet As String strFldr = CurrentProject.Path & "\tst" ' modify folder to your own strFile = Dir(strFldr & "\*.*") ' get list of files in folder Do While Len(strFile) > 0 FileToGet = left(strFile, Len(strFile) - 4) If FileToGet <= CStr(Format(Date - 3, "yyyymmdd")) Then Kill strFldr & "\" & strFile Else End If strFile = Dir Loop End Sub Sub zerNc() On Error Resume Next Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB OldFile = DBOld DBwithEXT = Dir(OldFile) DBwithoutEXT = left(DBwithEXT, Len(DBwithEXT) - 4) Application.SetOption "Use Hijri Calendar", False NewFile = DBNew & "\" & Format(Now, "yyyymmddhhnnss") & ".mdb" CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub Me.Requery Call delfiles End Sub db.rar

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

يمكن وعلى نحو ما تفضلت به ولكننا نحتاج الى بعض التعديلات التعديل الاول على نوع الحقل id داخل الجدول الى نص بدلا من رقم حتى يقبل الرموز التعديل الثاني : هو اجراء المقارنة على الارقام الثلاثة الاخيرة بدلا من مقارنة الرقم كاملا والسبب وجود الرمز الفاصل وتعديلات اخرى يمكنك ملاحظتها عند المقارنة مع الكود السابق Private Sub Form_BeforeInsert(Cancel As Integer) On Error Resume Next Dim xLast, xNext As Integer Dim prtyr, prtTxt As Integer prtyr = DatePart("yyyy", Date) prtTxt = CLng(Left(DMax("ID", "tbl1"), 4)) xLast = CLng(Right(DMax("ID", "tbl1", prtTxt = prtyr), 3)) If IsNull(xLast) Then xNext = 1 Else xNext = xLast + 1 End If Me!ID = prtyr & "/" & Format(xNext, "000") End Sub ترقيم مع السنة.rar

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

عدم الرد من صاحب السوال جعلني ادخل مرة اخرى اواكتشف اني لم ارفق الوحدة المسؤولة عن الترجمة تفصل والصقها في صفحة وحدة نمطية جديدة Public Ok, Cancel, ABORT Public RETRY, IGNORE, YES, NO Private m_hHook As Long Private Const IDOK = 1 Private Const IDCANCEL = 2 Private Const IDABORT = 3 Private Const IDRETRY = 4 Private Const IDIGNORE = 5 Private Const IDYES = 6 Private Const IDNO = 7 Private Const WH_CBT = 5 Private Const GWL_HINSTANCE = (-6) Private Const HCBT_ACTIVATE = 5 Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, _ ByVal lpString As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long Public Sub MessageBoxH(hwndThreadOwner As Long) Dim hInstance As Long Dim hThreadId As Long hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE) hThreadId = GetCurrentThreadId() m_hHook = SetWindowsHookEx(WH_CBT, AddressOf _ MsgBoxHookProc, hInstance, hThreadId) End Sub Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal _ wParam As Long, ByVal lParam As Long) As Long If uMsg = HCBT_ACTIVATE Then SetDlgItemText wParam, IDOK, Ok SetDlgItemText wParam, IDCANCEL, Cancel SetDlgItemText wParam, IDABORT, ABORT SetDlgItemText wParam, IDRETRY, ABORT SetDlgItemText wParam, IDIGNORE, ABORT SetDlgItemText wParam, IDYES, YES SetDlgItemText wParam, IDNO, YES UnhookWindowsHookEx m_hHook End If MsgBoxHookProc = False End Function

شكرا اخي جعفر على هذه النوادر الجميلة وتفضل اخي عبدالله يمكنك كتابة اي شيء على الزر Dim resalh As Integer Ok = "أكيد موافق" Cancel = "not agree" MessageBoxH Me.hwnd resalh = MsgBox("تفضل هذه الخلطة في اللغة", vbOKCancel, "رسالة")

اجعل مصدر بيانات النموذج الفرعي استعلام خارجي ثم استخدم الدالة Dlookup لفحص الاستعلام

وذات التاريخ الاحدث لا ينطبق عليها الشرط

الموظف لا تنطبق عليه الشروط فالمعيار الموجود هو Between -5 And 6 بينما القيمة عند الموظف المذكور 10-

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

اختر في حقل التاريخ القيمة max بدلا من group by ايضا لا بد من استبعاد الحقول التي يوجد فيها قيم متباينة ويمكنك جلب التاريخ الاحدث باستخدام الدالة Dmax بمعلومية المعرف مثلا

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

ارفق مثالك حتى يتمكن اخوانك من مساعدتك

اعمل تقرير فرعي داخل التقرير الرئيسي ، ويمكن ان تضع داخل التقرير نموذج فرعي ايضا

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

الملف كامل غير مطلوب فقط انزع النموذجين والجدولين من برنامجك واجعلهما في قاعدة جديدة ثم ارفقهما بعد الضغط

وايضا هذا الرابط في هذا الباب

السلام عليكم اخونا الشمال يريد الترقيم عند الطباعة فقط وليس عند المعاينة اظن ان الكود سليم مافيه شي هل هذا صحيح ؟

يامرحبـا عـد النجــــــوم بسمانـا ومع جيتــــك عـم الفـرح منتدانـا

جزاك الله خيرا ابا عبدالله وهذا كود للجمع يختلف قليلا والنتيجة واحدة Expr2: (Sum([expr1])\60 & Format(Sum([expr1]) Mod 60;"\:00")) جمع تأخر الحضور.rar

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