ابوخليل

تفضل هذا تطبيق للفكرة التي ذكرتها اعلاه dty = DMax("edate", "employees") If Me.edate < dty Then Me.AllowEdits = False Me.fvacations.Locked = True Else Me.AllowEdits = True Me.fvacations.Locked = False End If db1.rar

تعليق على كلام اخونا محمد سلامة المثل عندنا يقول : من تردد في ارض عرفها اخوي زوهير المسألة بالضبط كما في اكسل سحب واسقاط من مربع الادوات انظر المثال الجديد ما تبحث عنه حقيقة صنعته لك في فورم جديد اما الفورم الاول فهو عبارة عن حركات تحاكي علامة الجدولة Tabs.rar

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

ارفق مثالك واجعله على صيغة mdb يلاحظ في المثال الا يزيد على جدول واحد ونموذج وتقرير

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

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

يمكنك كتابة كلمة : للرفع للتذكير بوضوعك بدلا من انشاء موضوع جديد

هل تقصد علامات الجدولة ؟ ايضا اليك طريقة اخرى لاخفاء اطار اكسس هذه اجعلها في وحدة نمطية عامة Global Const ME_HIDE = 0 Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal sCmdShow As Long) As Long Sub sHidwindow() Dim NMC As Long NMC = apiShowWindow(hWndAccessApp, ME_HIDE) End Sub وهذا السطر اجعله في حدث فتح النموذج Call sHidwindow اما علامة الجدولة فهي في صندوق الادوات يمكن سحبها وافلاتها داخل النموذج وهذا مثال لتلوين علامات الجدولة مع اخفاء اطار اكسس ColoredTabs.rar

لم افهم المطلوب وخاصة الميلتباج اذا كنت مبتدأ جدا في اكسس فانا ضعيف جدا في اكسل هل فتحت المثال ؟ وهل اختفى اطار اكسس ؟ قد لا يختفي في الاصدارات الحديثة ، واحب التنويه الى اني اعمل على اصدار 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 بمعلومية المعرف مثلا

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

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