كل الانشطه

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

مشاركة مع اساتذتي تفضل استاذ @بلال بلال مرفقك بعد التعديل . ووافني بالرد . البرنامج.rar

تم ارفاق قاعدة بيانات بسيطة للتجربة فى رأس الموضوع على الرغم من الشرح باستفاضة لعمل القاعدة

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

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

نموذج مثلا باسم : frmPasswordPrompt العناصر داخل النموذج كالتالى مربع نص باسم : txtPassword زر امر للتأكيد باسم : btnOK زر امر للالغاء والاحباط باسم : btnCancel واستخدم الاكواد التالية فى هذا النموذج Private Sub Form_Load() Me.KeyPreview = True Me.txtPassword.Value = "" Me.txtPassword.SetFocus End Sub Private Sub btnOK_Click() PasswordConfirm Nz(Me.txtPassword.Value, "") DoCmd.Close acForm, Me.Name End Sub Private Sub btnCancel_Click() PasswordCancel DoCmd.Close acForm, Me.Name End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then KeyCode = 0 btnCancel_Click End If End Sub قم بانشاء وحدة نمطية عامة اعطها مثلا اسم : basPasswordPrompt الاكواد داخل الوحدة النمطية تكون كالتالى : Option Compare Database Option Explicit Public Enum PasswordStatus psEmpty = 0 psInvalid = 1 psCancelled = 2 psMaxAttemptsExceeded = 3 psUnsupportedAction = 4 psDangerousSQL = 5 End Enum Public Enum ActionType atOpenForm = 0 atOpenQuery = 1 atOpenReport = 2 atPrintReport = 3 atDeleteAllRecords = 4 atExecuteSQL = 5 atRunGlobalFunction = 6 atRunFormMethod = 7 End Enum Private Const MAX_PASSWORD_ATTEMPTS As Long = 3 Private m_PasswordValue As String Private m_PasswordConfirmed As Boolean Private m_PasswordCancelled As Boolean Public Sub ExecuteAction( _ ByVal actionToExecute As ActionType, _ ByVal targetName As String, _ Optional ByVal expectedPassword As String = "", _ Optional ByVal callerForm As Access.Form = Nothing) On Error GoTo ErrorHandler If Len(Trim$(targetName)) = 0 Then Exit Sub Dim i As Long For i = 1 To MAX_PASSWORD_ATTEMPTS PromptPasswordForm If m_PasswordCancelled Then ShowMessage psCancelled Exit Sub End If If Len(m_PasswordValue) = 0 Then ShowMessage psEmpty GoTo NextTry End If If StrComp(m_PasswordValue, expectedPassword, vbBinaryCompare) <> 0 Then ShowMessage psInvalid GoTo NextTry End If ExecuteInternal actionToExecute, targetName, callerForm m_PasswordValue = "" Exit Sub NextTry: Next i ShowMessage psMaxAttemptsExceeded Exit Sub ErrorHandler: DoCmd.SetWarnings True m_PasswordValue = "" MsgBox Err.Number & " - " & Err.Description, vbCritical Debug.Print "ExecuteAction Error " & Err.Number & ": " & Err.Description End Sub Private Sub ExecuteInternal( _ ByVal actionToExecute As ActionType, _ ByVal targetName As String, _ ByVal callerForm As Access.Form) On Error GoTo ErrorHandler Select Case actionToExecute Case atOpenForm DoCmd.OpenForm targetName Case atOpenQuery DoCmd.OpenQuery targetName Case atOpenReport DoCmd.OpenReport targetName, acViewNormal Case atPrintReport DoCmd.OpenReport targetName, acViewNormal Case atDeleteAllRecords If MsgBox("هل أنت متأكد من حذف جميع السجلات؟", _ vbYesNo + vbCritical + vbDefaultButton2) <> vbYes Then Exit Sub End If SafeRunSQL "DELETE FROM [" & targetName & "]" Case atExecuteSQL If IsDangerousSQL(targetName) Then ShowMessage psDangerousSQL Exit Sub End If SafeRunSQL targetName Case atRunGlobalFunction Application.Run targetName Case atRunFormMethod If callerForm Is Nothing Then Exit Sub On Error Resume Next CallByName callerForm, targetName, VbMethod If Err.Number <> 0 Then MsgBox "Method '" & targetName & "' not found in form.", vbCritical Debug.Print "CallByName Error: " & Err.Description Err.Clear End If On Error GoTo ErrorHandler Case Else ShowMessage psUnsupportedAction End Select Exit Sub ErrorHandler: DoCmd.SetWarnings True MsgBox Err.Number & " - " & Err.Description, vbCritical Debug.Print "ExecuteInternal Error " & Err.Number & ": " & Err.Description End Sub Private Sub SafeRunSQL(ByVal sqlText As String) On Error GoTo ErrorHandler DoCmd.SetWarnings False DoCmd.RunSQL sqlText DoCmd.SetWarnings True Exit Sub ErrorHandler: DoCmd.SetWarnings True MsgBox "SQL Error " & Err.Number & vbCrLf & Err.Description, vbCritical Debug.Print "SafeRunSQL Error " & Err.Number & ": " & Err.Description End Sub Private Function IsDangerousSQL(ByVal sqlText As String) As Boolean Dim t As String t = Trim$(LCase$(sqlText)) If InStr(t, "drop ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "alter ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "create ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "truncate ") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "--") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "/*") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "*/") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, ";") > 0 Then IsDangerousSQL = True: Exit Function If InStr(t, "delete ") > 0 And InStr(t, "where") = 0 Then IsDangerousSQL = True: Exit Function End If If InStr(t, "update ") > 0 And InStr(t, "where") = 0 Then IsDangerousSQL = True: Exit Function End If IsDangerousSQL = False End Function Public Sub PromptPasswordForm() m_PasswordValue = "" m_PasswordConfirmed = False m_PasswordCancelled = False DoCmd.OpenForm "frmPasswordPrompt", WindowMode:=acDialog End Sub Public Sub PasswordConfirm(ByVal passwordValue As String) m_PasswordValue = passwordValue m_PasswordConfirmed = True m_PasswordCancelled = False End Sub Public Sub PasswordCancel() m_PasswordValue = "" m_PasswordConfirmed = False m_PasswordCancelled = True End Sub Public Function GetLastPassword() As String GetLastPassword = m_PasswordValue End Function Public Function WasPasswordCancelled() As Boolean WasPasswordCancelled = m_PasswordCancelled End Function Public Sub ShowMessage(ByVal status As PasswordStatus) Dim sMsg As String Dim nIcon As Long Select Case status Case psEmpty sMsg = "الرجاء إدخال كلمة السر للمتابعة" nIcon = vbExclamation Case psInvalid sMsg = "كلمة سر خاطئة. حاول مرة أخرى" nIcon = vbCritical Case psCancelled sMsg = "تم إلغاء الإجراء" nIcon = vbInformation Case psMaxAttemptsExceeded sMsg = "تم تجاوز عدد المحاولات المسموح بها" nIcon = vbCritical Case psUnsupportedAction sMsg = "إجراء غير مدعوم" nIcon = vbExclamation Case psDangerousSQL sMsg = "تم رفض تنفيذ SQL لأسباب أمنية" nIcon = vbCritical End Select MsgBox sMsg, nIcon + vbMsgBoxRight, "مطالبة كلمة السر" End Sub '======================================================== ' امثلة الاستدعاء والاستخدام '======================================================== ' 1) فتح نموذج ' ExecuteAction atOpenForm, "FormName", "1234" ' ' 2) فتح استعلام ' ExecuteAction atOpenQuery, "QueryName", "1234" ' ' 3) فتح تقرير ' ExecuteAction atOpenReport, "ReportName", "1234" ' ' 4) طباعة تقرير ' ExecuteAction atPrintReport, "ReportName", "1234" ' ' 5) حذف سجلات ' ExecuteAction atDeleteAllRecords, "TableName", "1234" ' ' 6) تنفيذ SQL ' ExecuteAction atExecuteSQL, "UPDATE Table SET Field=1 WHERE ID=5", "1234" ' ' 7) استدعاء دالة عامة ' ExecuteAction atRunGlobalFunction, "MyFunction", "1234" ' ' 8) استدعاء دالة من النموذج الحالي ' ExecuteAction atRunFormMethod, "MyMethod", "1234", Me ' ' 9) فتح نموذج حسب كلمة المرور — في النموذج: ' Private Sub Command0_Click() ' ' Dim sPass As String ' Dim i As Long ' Const MAX_TRIES As Long = 3 ' ' For i = 1 To MAX_TRIES ' ' PromptPasswordForm ' sPass = GetLastPassword() ' ' If WasPasswordCancelled() Then ' MsgBox "تم إلغاء الإجراء", vbInformation + vbMsgBoxRight, "مطالبة كلمة السر" ' Exit Sub ' End If ' ' If Len(sPass) = 0 Then ' MsgBox "الرجاء إدخال كلمة السر للمتابعة", vbExclamation + vbMsgBoxRight, "مطالبة كلمة السر" ' GoTo NextTry ' End If ' ' Select Case sPass ' Case "123": DoCmd.OpenForm "Form1": Exit Sub ' Case "456": DoCmd.OpenForm "Form2": Exit Sub ' Case "789": DoCmd.OpenForm "Form3": Exit Sub ' Case Else ' MsgBox "كلمة سر خاطئة. حاول مرة أخرى", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" ' End Select ' 'NextTry: ' Next i ' ' MsgBox "تم تجاوز عدد المحاولات المسموح بها", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" 'End Sub '======================================================== وتستطيع استخدام اى شئ بتمرير و بتطبيق كلمة مرور اولا من خلال احد الاستدعاءات التالية ' 1) فتح نموذج طبعا مع تغيير : FormName باسم النموذج الذى تريد فتحه ExecuteAction atOpenForm, "FormName", "YourPassword" ' 2) فتح استعلام طبعا مع تغيير : QueryName باسم الاستعلام الذى تريد فتحه ExecuteAction atOpenQuery, "QueryName", "YourPassword" ' 3) فتح تقرير طبعا مع تغيير : ReportName باسم التقرير الذى تريد فتحه ExecuteAction atOpenReport, "ReportName", "YourPassword" ' 4) طباعة تقرير طبعا مع تغيير : ReportName باسم التقرير الذى تريد طباعته ExecuteAction atPrintReport, "ReportName", "YourPassword" ' 5) حذف سجلات طبعا مع تغيير : TableName باسم الجدول الذى تريد حذف سجلاته ExecuteAction atDeleteAllRecords, "TableName", "YourPassword" ' 6) تنفيذ SQL اكتبالجملة حسب تصميمك Dim SQLStatement As String SQLStatement = "UPDATE tblSettings SET IsActive=1 WHERE ID=" & Me.txtID.Value ExecuteAction atExecuteSQL, SQLStatement, "1234" ' 7) استدعاء دالة عامة من اى وحدة نمطية عامة ExecuteAction atRunGlobalFunction, "FunctionName", "YourPassword" ' 8) استدعاء أى وظيفة أو إجراء داخل النموذج الحالى ExecuteAction atRunFormMethod, "MethodName", "YourPassword", Me طبعا تغير كلم : YourPassword بكلمة المرور التى تريدها وكلمة المرور ليست ثابتة تستطيع تغييرها دائما مع الاستدعاءات المختلفة على سبيل المثال لو اردت فتح كل نموذج ولكل نموذج كلمة مرور خاصة به هو ExecuteAction atOpenForm, "frmA", "000" ExecuteAction atOpenForm, "frmB", "111" ExecuteAction atOpenForm, "frmC", "222" وأخيرا لو اردت فتح احد النماذج المتعددة ولكن كل نموذج حسب تمرير كلمة مرور خاصة به استخدم الكود التالى Private Sub Command0_Click() Dim sPass As String Dim i As Long Const MAX_TRIES As Long = 3 For i = 1 To MAX_TRIES PromptPasswordForm sPass = GetLastPassword() If WasPasswordCancelled() Then MsgBox "تم إلغاء الإجراء", vbInformation + vbMsgBoxRight, "مطالبة كلمة السر" Exit Sub End If If Len(sPass) = 0 Then MsgBox "الرجاء إدخال كلمة السر للمتابعة", vbExclamation + vbMsgBoxRight, "مطالبة كلمة السر" GoTo NextTry End If Select Case sPass Case "123": DoCmd.OpenForm "Form1": Exit Sub Case "456": DoCmd.OpenForm "Form2": Exit Sub Case "789": DoCmd.OpenForm "Form3": Exit Sub Case Else MsgBox "كلمة سر خاطئة. حاول مرة أخرى", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" End Select NextTry: Next i MsgBox "تم تجاوز عدد المحاولات المسموح بها", vbCritical + vbMsgBoxRight, "مطالبة كلمة السر" End Sub فعندما يتم فتح نموذج المطالبة بكلمة مرور لو تم استخدام كلمة المرور : 123 يتم فتح النموذج : Form1 لو تم استخدام كلمة المرور : 456 يتم فتح النموذج : Form2 لو تم استخدام كلمة المرور : 789 يتم فتح النموذج : Form3 بديل InputBox.accdb

المطلوب : معادلات لتقسيم العدد في الخلية N9 , الخلية N17 على الاسبوع كما هو مبين بحيث بعض الايام ليس بها حصص والاخر به حصص لجميع ايام الاسبوع الاستمارة ك.xlsm

المهم انت عندك .. ده كفاية وانت من جواك عارف ومتيقن انى لو عاوز اعمل زيها بفضل الله سبحانه وتعالى هقدر 😉 ... برضو ده عندى كفاية 😛

عندك زيها 😉 😛

انت بتفكرني بـ " أذاكر وأنجح " 😂 انت لو قرأت الموضوع كويس كان عرفت انه الملف اللي انت محتاجه موجود في أول مشاركة 😉

الكود الافضل فى الوحدة النمطية تتم كتابته بالشكل التالى Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" _ (ByVal hHook As LongPtr, ByVal nCode As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" _ (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As LongPtr, _ ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As LongPtr) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hWnd As LongPtr, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function EnumChildWindows Lib "user32" _ (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As LongPtr, ByVal wMsg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Private m_hHook As LongPtr #Else Private Declare Function CallNextHookEx Lib "user32" _ (ByVal hHook As Long, ByVal nCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" _ (ByVal lpModuleName 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 Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hWnd As Long, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32" _ (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private m_hHook As Long #End If Private Const WH_CBT As Long = 5 Private Const HCBT_ACTIVATE As Long = 5 Private Const HC_ACTION As Long = 0 Private Const EM_SETPASSWORDCHAR As Long = &HCC Private Const EM_GETPASSWORDCHAR As Long = &HD2 Private Const PASSWORD_CHAR As Long = 42 Private Const DIALOG_CLASS As String = "#32770" Private Const EDIT_CLASS As String = "Edit" #If VBA7 Then Public Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long Dim sClass As String Dim nChars As Long Dim verifyChar As LongPtr #Else Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim sClass As String Dim nChars As Long Dim verifyChar As Long #End If sClass = String$(256, vbNullChar) nChars = GetClassName(hWnd, sClass, 255) If nChars <= 0 Then EnumChildProc = 1 Exit Function End If If Left$(sClass, nChars) <> EDIT_CLASS Then EnumChildProc = 1 Exit Function End If SendMessage hWnd, EM_SETPASSWORDCHAR, PASSWORD_CHAR, 0 verifyChar = SendMessage(hWnd, EM_GETPASSWORDCHAR, 0, 0) If verifyChar = PASSWORD_CHAR Then EnumChildProc = 0 Else EnumChildProc = 1 End If End Function #If VBA7 Then Public Function HookCallback(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr #Else Public Function HookCallback(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long #End If Dim sClassName As String Dim nChars As Long If nCode < HC_ACTION Then HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam) Exit Function End If If nCode = HCBT_ACTIVATE Then sClassName = String$(256, vbNullChar) nChars = GetClassName(wParam, sClassName, 255) If nChars > 0 Then If Left$(sClassName, nChars) = DIALOG_CLASS Then EnumChildWindows wParam, AddressOf EnumChildProc, 0 End If End If End If HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam) End Function Public Function SecureInputBox( _ ByVal Prompt As String, _ Optional ByVal Title As String = "", _ Optional ByRef WasCancelled As Boolean = False, _ Optional ByVal XPos As Long = -1, _ Optional ByVal YPos As Long = -1) As String Dim sResult As String Dim threadID As Long #If VBA7 Then Dim hMod As LongPtr #Else Dim hMod As Long #End If If Len(Trim$(Prompt)) = 0 Then err.Raise vbObjectError + 1001, "SecureInputBox", "Prompt cannot be empty." End If On Error GoTo SafeExit threadID = GetCurrentThreadId() hMod = GetModuleHandle(vbNullString) m_hHook = SetWindowsHookEx(WH_CBT, AddressOf HookCallback, hMod, threadID) If m_hHook = 0 Then err.Raise vbObjectError + 1002, "SecureInputBox", "Failed to install Windows hook." End If If XPos >= 0 And YPos >= 0 Then sResult = InputBox(Prompt, Title, "", XPos, YPos) Else sResult = InputBox(Prompt, Title, "") End If WasCancelled = (StrPtr(sResult) = 0) SecureInputBox = sResult SafeExit: If m_hHook <> 0 Then UnhookWindowsHookEx m_hHook m_hHook = 0 End If If err.Number <> 0 Then Dim errNum As Long, errDesc As String errNum = err.Number errDesc = err.Description err.Clear err.Raise errNum, "SecureInputBox", errDesc End If End Function Public Sub ZeroString(ByRef sValue As String) If Len(sValue) > 0 Then sValue = String$(Len(sValue), vbNullChar) End If End Sub فى زر الامر يتم الاستدعاء بالشكل التالى Dim strPWord As String Dim strTitle As String Dim isCancel As Boolean strTitle = "سبحان الله وبحمده سبحان الله العظيم" strPrompt = "كلمة المرور مطلوبة للمتابعة." strPWord = SecureInputBox(strPrompt, strTitle, isCancel) If isCancel Then Exit Sub If strPWord = "1001" Then DoCmd.OpenForm "frmPassStars", acNormal Else MsgBox "الرقم السري الذي أدخلته غير صحيح - من فضلك أدخل الرمز الصحيح", vbExclamation, str_Title End If ZeroString strPWord

خلينا نرد الرقم &H1324 مش ثابت بيشتغل في أغلب الحالات لكن ممكن يفشل حسب إصدار الاوفيس او الويندوز دا غير ان لو حصل Error قبل : UnhookWindowsHookEx hHook الهـوك هيفضل شغال فى زر الامر تم استخدام : Cancel = True Cancel بيستخدم فقط في Events فيها معامل : Cancel مثلا زى : Form_BeforeUpdate(Cancel As Integer) يعنى من الاخر السطر ده : Cancel = True مالوش أي تأثير والمفروض ينحذف كمان استخدام : DoCmd.SetWarnings False مالوش أى لزوم هنا لانه بيستخدم مع الاستعلامات لمنع الرسائل الافتراضية فقط والرد الشافى فى النقطة دى المعامل الثالث (Default) هو النص الافتراضي داخل مربع الإدخال فيه احتمالين للمشكلة مع 32 بت الاول : الهوك بيشتغل لحظة إنشاء النافذة وجود نص افتراضي (Default) يخلي الكنترول يتعمل له تهيئة بطريقة مختلفة النتيجة: الـ Password masking (*) ما يتطبقش أو يحصل خلل الثانى : اختلاف داخلي في الـ : InputBox (32 بت مقابل 64 بت) الـ Edit control ID (&H1324) بيتأثر بوجود Default Text مع النواة 32 او مع احد الاصدارات والنتيجة : EM_SETPASSWORDCHAR ممكن تروح لعنصر غلط أو تفشل طيب السؤال الان هل الحل ده صح و جذرى: InputBoxDK("Password required to proceed.", str_Title) من حيث الصحة : جزئيا صح ولكن مش جذرى ومش احترافى ومش الأصح طيب إيه الحل الصح : strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "") وبعد ان قمنا بالتفنيد والرد المناسب واللى ماله علاقة اساسا بالمشكلة مناط السؤال المشكلة الحقيقية تكمن فى خلل بقاعدة البيانات المرفقه نفسها لو عملت قاعدة جديدة وقمت باستيراد العناصر ( النماذج والوحدة النمطية العامة ) تقريبا سوف تنحل مشكلتك والسبب فى الصورة التالية من قاعدتك أكود لعناصر شبحية تم حذفها ولكن مازالت عالقة بالقاعدة

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

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

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

وانا اتمنى كذلك و مشتاق لارى الاضافات الجميلة والافكار

تفضل استاذ @بلال بلال وانا اسف على المشاكة السابقة لأني كنت فاهم الموضوع غير المهم تفضل الشرح والمرفق وانت عندك الباسوورد . ووافني بالرد . Yamen-QRCode_WithTrialPeriod.rar

فى انتظار نهاية المدة بلهفة واشتياق علشان نشوف الافكار النيرة ......... علشان نتعلم ونثقل خبرتنا

الأســـــــــد يزأر في المدى سلطانَه ...... والكــلب إن عوى فلا يسمع له خطابُ ها هي الأســــود وإن أُهينت زئيرها ...... يبقى يسيـــرُ بهيبتهِ ويُهـــــــــــــــــابُ تبقى الكـــــــــلاب وإن تعالت لحظةً ...... ‏في أرضها محصورة، يحكمها الخـــرابُ تمضي الأسودُ في عـزٍّ وفي شَـمَـمٍ ...... وتبقى الكــــــلابُ تنبـحُ فـي السِّـرابِ ستشرقُ شمـسُ الحـقِّ بعد غيابها ...... ويصمتُ حينها نباحُ الكــــــــــــــــــــلابِ

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

مشاركة مع استاذي @Eng.Qassim تفضل استاذ @بلال بلال الشرح والمرفق . مع الاخذ بااعتبار يومي الجمعة والسبت والاجازات العامة لم تحسب . ووافني بالرد . Yamen-Trial Period.rar

ههههههههههههه يخلق من الشبه 40 مش عارف شوفت بعض الافكار فين بس برافو تطبيق رائع

فكرة رائعة

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل الاكواد التى تمت كتابتها لهذا العمل Option Compare Database Option Explicit Private mHostForm As Access.Form Private mRecordCount As Long Private mIsInitialized As Boolean Private mLastPosition As Long Private mLastCount As Long Private mLastIsNew As Boolean Private mHasLastState As Boolean Private Sub Form_Load() InitializeNavigator End Sub Private Sub InitializeNavigator() If Not EnsureHostForm Then Exit Sub RefreshRecordCount True With mHostForm.Recordset If Not (.BOF And .EOF) Then .MoveFirst End With UpdateUI mIsInitialized = True End Sub Private Sub Form_Current() If mIsInitialized Then UpdateUI End Sub Private Function EnsureHostForm() As Boolean On Error GoTo ErrorHandler If mHostForm Is Nothing Then If TypeOf Me.Parent Is Form Then Set mHostForm = Me.Parent End If ExitFunction: EnsureHostForm = Not (mHostForm Is Nothing) Exit Function ErrorHandler: Set mHostForm = Nothing Resume ExitFunction End Function Private Function HasRecords() As Boolean HasRecords = (mRecordCount > 0) End Function Private Sub RefreshRecordCount(Optional ByVal force As Boolean = False) On Error GoTo ErrorHandler If Not EnsureHostForm Then mRecordCount = 0 Exit Sub End If If Not force Then If mRecordCount > 0 Then Exit Sub End If With mHostForm.RecordsetClone If .BOF And .EOF Then mRecordCount = 0 Else .MoveLast mRecordCount = .recordCount End If End With ErrorHandler: End Sub Private Function GetCurrentPosition() As Long On Error GoTo ErrorHandler If Not EnsureHostForm Then GetCurrentPosition = 0 ElseIf mRecordCount <= 0 Then GetCurrentPosition = 0 ElseIf mHostForm.NewRecord Then GetCurrentPosition = mRecordCount + 1 Else Dim pos As Long pos = mHostForm.CurrentRecord If pos <= 0 Then pos = 1 GetCurrentPosition = pos End If Exit Function ErrorHandler: GetCurrentPosition = 0 End Function Private Sub UpdateUI() On Error GoTo SafeExit Dim frm As Form Dim currentPosition As Long Dim isEmpty As Boolean Dim isNew As Boolean Dim isFirst As Boolean Dim isLast As Boolean If Not EnsureHostForm Then If Not mHasLastState _ Or mLastPosition <> 0 _ Or mLastCount <> 0 _ Or mLastIsNew <> False Then Me.lblRecordPosition.Caption = "0 of 0" Me.cmdGoFirst.Enabled = False Me.cmdGoPrevious.Enabled = False Me.cmdGoNext.Enabled = False Me.cmdGoLast.Enabled = False Me.cmdDeleteCurrent.Enabled = False mLastPosition = 0 mLastCount = 0 mLastIsNew = False mHasLastState = True End If Exit Sub End If Set frm = mHostForm currentPosition = GetCurrentPosition() isEmpty = (mRecordCount <= 0) isNew = frm.NewRecord If mHasLastState Then If mLastPosition = currentPosition _ And mLastCount = mRecordCount _ And mLastIsNew = isNew Then Exit Sub End If If isEmpty Then Me.lblRecordPosition.Caption = "0 of 0" Else Me.lblRecordPosition.Caption = currentPosition & " of " & mRecordCount End If isFirst = (currentPosition <= 1 And Not isNew) isLast = (currentPosition >= mRecordCount And Not isNew) Me.cmdGoFirst.Enabled = Not isEmpty And Not isFirst Me.cmdGoPrevious.Enabled = Not isEmpty And Not isFirst Me.cmdGoNext.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdGoLast.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdDeleteCurrent.Enabled = Not isEmpty And Not isNew mLastPosition = currentPosition mLastCount = mRecordCount mLastIsNew = isNew mHasLastState = True Exit Sub SafeExit: Debug.Print "UpdateUI Error: "; Err.Number; " - "; Err.Description End Sub Private Sub cmdGoFirst_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveFirst mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoPrevious_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then cmdGoLast_Click Exit Sub End If On Error GoTo ErrorHandler With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark If mHostForm.CurrentRecord > 1 Then .MovePrevious mHostForm.Bookmark = .Bookmark End If End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoNext_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub On Error GoTo ErrorHandler If mHostForm.CurrentRecord >= mRecordCount Then UpdateUI Exit Sub End If With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark .MoveNext If Not .EOF Then mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoLast_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveLast mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdCreateNew_Click() On Error GoTo ErrorHandler If Not EnsureHostForm Then Exit Sub mHostForm.SetFocus DoCmd.GoToRecord acDataForm, mHostForm.name, acNewRec RefreshRecordCount True UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdDeleteCurrent_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub If MsgBox("هل تريد حذف السجل الحالي نهائيًا؟", vbYesNo + vbQuestion + vbDefaultButton2, "تأكيد الحذف") <> vbYes Then Exit Sub On Error GoTo ErrorHandler Dim rsClone As DAO.Recordset Dim bm As Variant Dim nextBM As Variant Set rsClone = mHostForm.RecordsetClone bm = mHostForm.Bookmark rsClone.Bookmark = bm rsClone.MoveNext If rsClone.EOF Then rsClone.Bookmark = bm rsClone.MovePrevious If rsClone.BOF Then nextBM = Null Else nextBM = rsClone.Bookmark End If Else nextBM = rsClone.Bookmark End If If mHostForm.Dirty Then mHostForm.Dirty = False End If mHostForm.Recordset.Delete RefreshRecordCount True If IsNull(nextBM) Then mHostForm.SetFocus DoCmd.GoToRecord , , acNewRec Else mHostForm.Bookmark = nextBM End If rsClone.Close Set rsClone = Nothing UpdateUI Exit Sub ErrorHandler: On Error Resume Next If Not rsClone Is Nothing Then rsClone.Close Set rsClone = Nothing End If HandleNavigatorError Err.Number, Err.Description End Sub Private Sub HandleNavigatorError(ByVal errorNumber As Long, ByVal errorDescription As String) Select Case errorNumber Case 0, 3021 Exit Sub Case Else MsgBox "حدث خطأ رقم " & errorNumber & vbCrLf & errorDescription, vbExclamation, "خطأ في أداة التنقل" End Select End Sub Navigator.accdb

رائع