ابو جودي

السلام عليكم ورحمة الله تعالى وبركاته تم تلافى الكثير من المشاكل وتم تحديث النسخة اليوم اليكم الاصدار الجديد ان شاء الله فى رأس الموضوع أو يمكنكم تحميل التعديل الاخيــر من >>---> تحميل التحديث للإصدار الأخير

ممكن توضيح اكثر يعنى اى قصدك من اضافة اى بيانات من مصدر خارجى ؟؟؟؟

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

طيب وبعد التحليل للمرفق ومن غير اى اكواد ممكن جملة الاستعلام دى تحل لك كل مشاكلك SELECT Table1.code, Table1.test, Table1.result, Table2.Cal, Nz([result], 0)/Nz([Cal], 1) AS FinalCalc FROM Table1 INNER JOIN Table2 ON Table1.code = Table2.code; وما اخدت بالى من موضوع التقريب لو اردنا استخدام التقريب تكون جملة الاستعلام بالشكل التالى SELECT Table1.code, Table1.test, Table1.result, Table2.Cal, IIf(Nz([result], 0) <> 0 And Nz([Cal], 1) <> 0, Round(Nz([result], 0) / Nz([Cal], 1), 3), Nz([result], 0) / Nz([Cal], 1)) AS FinalCalc FROM Table1 INNER JOIN Table2 ON Table1.code = Table2.code; وهذا هو المرفق انظر الى الاستعلام مباشرة وغير القيم فى الحقل Cal تظهر لك النتيجة المرجوة مباشرة فى الحقل FinalCalc دا اذا كنت قدرت افهم انت عاوز ايه Cal error.accdb

انا حاولت اكثر من ساعة احاول افهم هو عاوز ايه ومقدرتش افهم والله على العمود طبعا انا اتفق تماما مع رأى استاذى الجليل و ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل ولأنه لم نفهم الية العمل او فكرة صاحب المسألة هذه فكرتى وظيفة ثغنونه وبنت حلال تعمل كل ده Function GetDLookupResult(code1 As Long, code2 As Long) As Double Dim result1 As Variant Dim result2 As Variant ' Retrieve the value from Table1 based on the passed values result1 = DLookup("result", "Table1", "[code] = " & code1) result2 = DLookup("result", "Table1", "[code] = " & code2) ' Check if the values are not null to avoid errors If IsNull(result1) Or IsNull(result2) Then GetDLookupResult = 0 ' Or return a blank value or an error message Exit Function End If ' Calculate the final result GetDLookupResult = result1 / result2 End Function مرر القيم التى تريد اليها بالشكل التالى من خلال زر الامر Dim finalResult As Double finalResult = GetDLookupResult(33, 36) Me.C = finalResult

جزاك الله خيرا الله يرحم والديك وكل المسلمين يارب

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

فى الواقع يا استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @jjafferr الخسارة الفعلية والحقيقية لنا نحن طلاب العلم من غياب اساتذتنا العظماء اركان هذا الصرح الشامخ والفضل كل الفضل لكم من بعد رب العزة سبحانه وتعالى شكر الله لكم حسن حلمكم وكرم اخلاقكم فى نقل خبراتكم وتعليمكم روعايتكم لنا ... جزاكم الله تعالى عنى وعن كل طلاب العلم كل الخير ويعلم الله انه منذ وقت انضمامى الى هذا الصرح الشامخ اول ما ابحث عنه عندما ادخل المنتدى ردود ومشاركات حضرتك واستاذى الجليل و ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل والاستاذ @أبو إبراهيم الغامدي والاستاذ @رمهان و الاستاذ @أبا عمر والاستاذ @SEMO.Pa3x و الاستاذ @أبو آدم وغيرهم الكثير الذين تعلمت انا شخصيا ولازلت حتى الان اتعلم من مشاركتهم حتى ولو كانت قديمه منهم من طال غيابه ومنهم من يدخل حسبما يسمح وقته اسأل الله تعالى لكل اساتذتى العظماء الذين ذكرتهم والذين لم اذكرهم ولكل من تعلمنا منهم وعلى ايديهم بكل حرف حسنه وان يضاعف لهم من فضله الكريم اضعافا مضاعفة واسأله ان يُكتب لهم فى موزاين اعمالهم علم ينتفع به وصدقة جارية الى يوم الدين ان شاء الله ... اللهم امين امين امين احبكم فى الله

اعتذر على التأخير اتفضل يا سيدى تم تحويل القاعدة للتنسيق 2000 بامتداد mdb الاكواد تعمل على النواتان 32 , 64 بيت Security(Enable-Disable Shift Key).zip

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

تم اضافة اصدار جديد لتنقيح وتفادى بعض الاخطاء بتاريخ 22/09/2024 - ضبط اسهم زيادة او نقصان الشهور والسنوات تبعا لترتيب واجهة ترتيب التواريخ ( يمين / يسار ) - ضبط الفتح التلقائى لقائمة السنوات او الشهور لاغلاقها اذا كانت مفتوحة بدلا من اعادة فتح القائمة مرة اخرى عند تكرارا الضغط رقم الاصدار الجديد 4 يمكن تحميل مرفق الاصدار الجديد من رأس الموضوع او من هنا Handler - calendar (V4).accdb

طيب فى حلين اولا الحل البسيط عمل دالة للحفظ وتتم مباشرة بعد توليد رقم الفاتورة Private Sub DoSave() On Error GoTo ErrorHandler ' Check if there are unsaved changes If Me.Dirty Then ' Save the current record DoCmd.RunCommand acCmdSaveRecord End If ' Exit the sub normally Exit Sub ErrorHandler: ' Handle the error and display a message with the error number and description MsgBox "Error occurred while saving the record: " & Err.Number & " - " & Err.Description, vbCritical, "Error" ' Resume to the end of the sub after handling the error Resume ExitHandler ExitHandler: ' End of the sub Exit Sub End Sub الحل الثانى مشاركة لاستاذى الجليل و معلمى القدير و و الدى الحبيب الستاذ @jjafferr اليك الموضوع كاملا

السلام عليكم ورحمة الله تعالى وبركاته طبعا قد يقول البعض ان الموضوع اتهرس فى ميت فيلم عربى قبل كده لكن على كل حال تم تدارك الكثير من المشاكل ومعالجتها بشكل احترافى - اخفاء اطار لاكسس بالشكل الطبيعى والتقليدى لعرض النموذج كاملا - اخفاء اطار الاكسس وعمل شفافية للنموذج لاظهار صور png او حسب خيال المسخدم - تم ضبط كواد التوسيط للنماذج والتقارير باحترافية ويعمل التوسيط مع الخاصية Pop Up فى اى وضع كانت فى حالة عدم استخدام الاخفاء - تم حل مشكلة عدم ظهور التقاربر عند الاخفاء بتكبير التقرير تلقائيا عند استخدام كود الاخفاء - امكانبة التصغير للتطبيق بجوار الساعة ( System Try ) - عند التصغير بجوار الساعة ممكن الضغط كليك يمين على الايقونة لتظهر قائمة اختيارات - تم ضبط كود تغير ايقونة الاكسس باحترافية وبشكل تلقائى من المسار المحدد او فى حالة عدم وجود الايقونة ترجع ايقونة الاكسس - تم التعامل مع الاكواد بحرفية تامة للعمل على بيئات الأنوية المختلفة سواء كانت 32 , 64 اترككم مع تجربة شيقة ملاحظة هامة : ارضاء للجميع ولاضفاء اكبر قدر ممكن من المرونة المرفق يحتوى على قاعدتان الاولى : تم تجميع كل الاكواد والدوال فى وحدة نمطية عامة واحدة وكلاس موديول واحد لسهولة الاستفادة منها ونقلهم الى اى قاعدة الثانية : فصل اكواد كل وظيفة على حدة فى مديول خاص بها تم اضافة تعديل وتحديث جديد بتاريخ 11/10/2024 رقم اصدار التعديل الاخيــر : 4.8 center and Hid and Tray Minimizer V 30.zip center and Hid and Tray Minimizer V 4.8.rar

مبدئيا اعمل وحدة نمطية جديدة وسميها مثلا: basInputBoxWithMask ضع الاكواد الاتية بالوحدة النمطية Option Compare Database Option Explicit '********************************************************************** ' Module: MaskedInputBox ' Purpose: This module provides functionality to create an InputBox ' with masked input, displaying characters as asterisks (*) ' typically used for password entry. ' ' API Declarations: ' - CallNextHookEx: Passes the hook information to the next hook procedure in the current hook chain. ' - GetModuleHandle: Retrieves a module handle for the specified module. ' - SetWindowsHookEx: Installs a hook procedure into the hook chain. ' - UnhookWindowsHookEx: Removes a hook procedure installed in a hook chain. ' - SendDlgItemMessage: Sends a message to a control in a dialog box. ' - GetClassName: Retrieves the name of the class to which the specified window belongs. ' - GetCurrentThreadId: Retrieves the thread identifier of the calling thread. ' ' Constants: ' - EM_SETPASSWORDCHAR: Used to specify the character to be displayed when text is entered in a password field. ' - WH_CBT: Hook type for monitoring and modifying Computer-Based Training (CBT) events. ' - HCBT_ACTIVATE: Hook code that is sent when a window is about to be activated. ' - HC_ACTION: Indicates a valid action has taken place, allowing processing to continue. ' ' Author: Officena.net, Mohammed Essm, soul-angel@msn.com ' Date: August 2024 '********************************************************************** #If VBA7 Or Win64 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As Any) 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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Any) 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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 GetCurrentThreadId Lib "kernel32" () As Long #End If ' Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 #If VBA7 Or Win64 Then Private hHook As LongPtr #Else Private hHook As Long #End If '********************************************************************** ' Function: NewProc ' Purpose: This function is the hook procedure that processes CBT ' events, specifically to mask input characters in an InputBox. ' Inputs: ' - lngCode: The code of the event (Long). ' - wParam: A handle to the window related to the event (Long). ' - lParam: Pointer to an event-specific structure (Long). ' Returns: - LongPtr: The result from the next hook procedure or 0 if handled. ' Notes: ' - Only processes events with code >= HC_ACTION. ' - Checks for dialog box activation and sets the password character. ' ' Author: Officena.net, Mohammed Essm, soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr Dim strClassName As String Dim lngBuffer As Long Dim result As Long ' Proceed only if the message code is an action code If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If ' Get the class name of the window being activated strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then result = GetClassName(wParam, strClassName, lngBuffer) ' Check if the class name is a dialog box ("#32770") If Left$(strClassName, result) = "#32770" Then ' Set the character for password masking SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If ' Call the next hook in the chain and return its value NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) End Function '********************************************************************** ' Function: InputBoxDK ' Purpose: Displays an InputBox with masked input, showing each character ' as an asterisk (*) instead of the actual character. ' Inputs: ' - Prompt: The prompt string displayed in the InputBox (String). ' - Optional Title: The title of the InputBox window (String). ' - Optional Default: The default string displayed in the InputBox (String). ' - Optional XPos: The x-coordinate of the InputBox (Long). ' - Optional YPos: The y-coordinate of the InputBox (Long). ' - Optional HelpFile: The name of the Help file for the InputBox (String). ' - Optional Context: The Help context number for the InputBox (Long). ' Returns: - String: The string entered by the user in the InputBox. ' Notes: ' - Hooks into the CBT events to mask the input as the user types. ' - The hook is removed after the InputBox is closed to prevent resource leaks. ' ' Author: Officena.net, Mohammed Essm, soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long, Optional HelpFile As String, Optional Context As Long) As String On Error GoTo ExitProperly Dim lngModHwnd As LongPtr Dim lngThreadID As Long ' Get the current thread ID and module handle lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) ' Set the hook for CBT (Computer-Based Training) to monitor and modify dialog box creation hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) ' Show the InputBox InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) ExitProperly: ' Ensure the hook is removed to prevent resource leaks If hHook <> 0 Then UnhookWindowsHookEx (hHook) End Function بالنسبة للنموذج دى الاكواد وطبعا لا انصح باستخدام اللغة العربية داخل المحرر Option Compare Database Option Explicit Private Sub Command4_Click() DoCmd.GoToRecord , , acNewRec End Sub '********************************************************************** ' Subroutine: Checkbox_AfterUpdate ' Purpose: Toggles the InputMask property of a password input field based on the state of a checkbox. ' When the checkbox is checked, the password is displayed as plain text; ' when unchecked, the password is masked with the "Password" mask. ' Inputs: ' - None (uses the current state of the form's controls). ' Outputs: ' - None (modifies the InputMask property of the "pass" control). ' Notes: ' - This subroutine assumes that "Checkbox" is a control on the form and is tied to ' the user's action of toggling the checkbox. ' - If the checkbox is checked (True), the password will be shown in plain text. ' - If unchecked (False), the password will be masked. ' ' Author: Officena.net, Mohammed Essm, soul-angel@msn.com ' Date: August 2024 '********************************************************************** Private Sub Checkbox_AfterUpdate() ' Check the value of the checkbox and update the InputMask of the "pass" field accordingly If Me.Checkbox.Value = True Then Me.pass.InputMask = "" ' Show the password as plain text Else Me.pass.InputMask = "Password" ' Mask the password with the "Password" input mask End If End Sub '********************************************************************** ' Subroutine: jop_AfterUpdate ' Purpose: Validates the job role entered by the user and enforces role-specific constraints. ' If the job role is "مستخدم" (User), it checks if the maximum allowed number of ' users has been reached. If so, it prompts for a password to allow adding more users. ' Inputs: ' - None (uses the current state of the form's controls). ' Outputs: ' - None (may prevent form submission based on validation checks). ' Notes: ' - The subroutine assumes "jop" is a control on the form where the user selects their job role. ' - If the job role is not "محاسب" (Accountant) or "مستخدم" (User), an error message is shown, ' and the action is canceled. ' - If the job role is "مستخدم", the subroutine checks the number of existing users in the database. ' If there are already 3 users, the subroutine prompts for a password before allowing more users to be added. ' - The password required to add more users is hardcoded as "123". This should be secured in a production environment. ' ' Author: Officena.net, Mohammed Essm, soul-angel@msn.com ' Date: August 2024 '********************************************************************** Private Sub jop_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim UserCount As Integer Dim PasswordInput As String ' Get the current database Set db = CurrentDb() ' Validate the job role entered by the user If Me.jop.Value <> "محاسب" And Me.jop.Value <> "مستخدم" Then MsgBox "برجاء إدخال كلمة محاسب أو مستخدم فقط.", vbExclamation, "قيمة غير صحيحة" Cancel = True Exit Sub End If ' If the job role is "مستخدم", check the number of existing users If Me.jop.Value = "مستخدم" Then Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfUsers FROM tblUsers WHERE jop = 'مستخدم'") UserCount = rs!CountOfUsers ' If the maximum number of users has been reached, prompt for a password If UserCount >= 3 Then PasswordInput = InputBoxDK("لقد تم إدخال 3 سجلات لمستخدمين. يرجى إدخال كلمة السر لإضافة مستخدم جديد:") ' Validate the entered password If PasswordInput = "" Or PasswordInput <> "123" Then MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة مستخدم جديد.", vbExclamation Cancel = True End If End If rs.Close Set rs = Nothing End If ' Clean up Set db = Nothing End Sub

مش تقول يا دكتور ان انت عاوز كلمة السر مع inputbox