ابو جودي

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

السلام عليكم ورحمة الله تعالى وبركاته اليوم اقدم لكم هدية صغيرة ولكن النفع من ورائها عظيم جدا قد ينتج عن الكود اخطاء عند كتابة الكود قد نحتاج تتبع نتائج الكود قد محتاج معرفة القيم التى يعيدهها الكود قد نكتب استعلام مثلا زنقطع الاسطر ونضيف متغيرات نمرر منها قيما الى الاستعلام ونريد معرفة كبف سوف يراه الحاسوب فى النهاية وقد وقد و ........ الخ وهناك الكثير والكثير وما ذطرته هو فقط على سبيل المثال وليس الحصر اتتنى فكرة وهى كتابة كود فى موديول ليسهل الامور على مصممى قواعد البيانات فيضفى المرونة فى التعامل وكذا الاحترافية التامة مع هذا الامر وهو استخدام: Debug.Print وحتى لا اطيل عليكم اليكم الاكواد Option Compare Database Option Explicit '********************************************************************** ' Function: DebugPrint ' Purpose: Prints a message to the Immediate Window in the VBA editor and optionally logs it to a file. ' Inputs: ' Message - The message to be printed (String). ' Optional AddNewLine - A Boolean flag to add a new line after printing (default is True). ' Optional Prefix - A string to prefix the message (default is ""). ' Optional Suffix - A string to suffix the message (default is ""). ' Optional LogToFile - A Boolean flag to enable logging to a file (default is False). ' Optional FilePath - The path of the file where the log should be saved (default is ""). ' Returns: Nothing - The function performs a print and/or log operation. ' Notes: ' - The function sends the message to the Immediate Window. ' - If AddNewLine is True, a newline is added after the message. ' - Prefix and Suffix can be used to format the message. ' - LogToFile enables logging the message to a specified file. ' - Error handling is included to manage issues with file operations. '********************************************************************** ' Author: Officena.net , Mohammed Essm , soul-angel@msn.com ' Date: August 2024 '********************************************************************** Sub DebugPrint(ByVal Message As String, Optional ByVal AddNewLine As Boolean = True, _ Optional ByVal Prefix As String = "", Optional ByVal Suffix As String = "", _ Optional ByVal LogToFile As Boolean = False, Optional ByVal FilePath As String = "") Dim fullMessage As String Dim fileNum As Integer ' Construct the full message with prefix and suffix fullMessage = Prefix & Message & Suffix ' Print the message to the Immediate Window Debug.Print fullMessage ' Optionally add a newline after printing If AddNewLine Then Debug.Print "" ' Adds an empty line for separation End If ' Log the message to a file if specified If LogToFile And FilePath <> "" Then On Error GoTo ErrorHandler fileNum = FreeFile Open FilePath For Append As #fileNum Print #fileNum, fullMessage Close #fileNum On Error GoTo 0 End If Exit Sub ErrorHandler: ' Handle any errors that occur during file operations Debug.Print "Error occurred while logging to file: " & Err.Description On Error GoTo 0 End Sub ' Example 1: Print a simple message Rem Call DebugPrint("This is a simple message") ' Example 2: Print a message with a prefix and suffix, without adding a new line Rem DebugPrint("Error encountered!", AddNewLine:=False, Prefix:="Error: ", Suffix:=" [Check details]") ' Example 3: Print a message and log it to a file Rem DebugPrint("Logging this message to a file.", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt") ' Example 4: Print multiple messages with automatic new lines and logging Rem DebugPrint("Starting process...") Rem DebugPrint("Process in progress...") Rem DebugPrint("Process completed successfully!", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt") '--------------------------------------------------------------------------------------------------------------------------------------- '********************************************************************** ' Subroutine: OpenImmediateWindow ' Purpose: Opens the Immediate Window in the VBA editor and prepares it for input. ' Inputs: None ' Returns: Nothing ' Notes: ' - The Immediate Window is activated and ready for input. ' - This subroutine uses the SendKeys method to send keystrokes. ' - Error handling is included to manage potential issues with SendKeys. '********************************************************************** ' Author: Officena.net , Mohammed Essm , soul-angel@msn.com ' Date: August 2024 '********************************************************************** Public Sub OpenImmediateWindow() Dim shell As Object On Error GoTo ErrorHandler ' Create an instance of WScript.Shell to send keystrokes Set shell = CreateObject("WScript.Shell") With shell ' Send Ctrl+G to open the Immediate Window .SendKeys "^g ", True ' Send Tab to navigate if needed .SendKeys "{TAB}", True End With Application.VBE.MainWindow.Visible = True DoEvents 'this frees up the OS to repaint the screen Exit Sub ' Clean up Set shell = Nothing ErrorHandler: ' Handle any errors that occur during SendKeys operations Debug.Print "Error occurred while opening the Immediate Window: " & Err.Description On Error GoTo 0 End Sub '********************************************************************** ' Function: ClearImmediateWindowContent ' Purpose: Clears the content of the Immediate Window in the VBA Editor. ' Details: ' This function searches for an open Immediate Window within the VBE. ' If found, it sends keystrokes to clear the content using the WScript.Shell object. ' Inputs: None ' Returns: Void ' Error Handling: ' Includes basic error handling to inform the user in case of an issue. ' Notes: ' - This function assumes that there is only one Immediate Window open. ' - The function does not create a new Immediate Window if one is not found. '********************************************************************** Public Function ClearImmediateWindowContent() On Error GoTo ErrorHandler Dim totalVBEWindows As Long Dim currentWindowIndex As Long Const IMMEDIATE_WINDOW_TYPE As Long = 5 ' Type constant for Immediate Window Dim shell As Object ' Create an instance of WScript.Shell to send keystrokes Set shell = CreateObject("WScript.Shell") totalVBEWindows = Application.VBE.Windows.Count ' Get the number of open windows ' Iterate through all open windows For currentWindowIndex = 1 To totalVBEWindows ' Check if the current window is the Immediate Window If Application.VBE.Windows.Item(currentWindowIndex).Type = IMMEDIATE_WINDOW_TYPE Then Application.VBE.Windows.Item(currentWindowIndex).SetFocus ' Set focus to the Immediate Window ' Ensure the Immediate Window is active If Application.VBE.ActiveWindow.Type = IMMEDIATE_WINDOW_TYPE Then With shell ' Send Ctrl+G to activate the Immediate Window .SendKeys "^g", True ' Send Ctrl+A to select all content .SendKeys "^a", True ' Send Delete to clear selected content .SendKeys "{DEL}", True ' Send Backspace to ensure content is cleared .SendKeys "{BKSP}", True End With Exit Function ' Exit after clearing the content End If Exit For ' Exit the loop if Immediate Window is found and focused End If Next currentWindowIndex ' Clean up Set shell = Nothing Exit Function ErrorHandler: MsgBox "Error occurred while trying to clear the Immediate Window. Error: " & Err.Description, vbCritical ' Clean up Set shell = Nothing End Function '********************************************************************** ' Function: GetDesktopPath ' Purpose: Returns the path to the Desktop for the current user. ' Details: ' This function retrieves the path to the Desktop folder using Windows API functions. ' Inputs: None ' Returns: String - The full path to the Desktop folder. ' Notes: ' - This function uses Windows API to get the Desktop path. ' - Ensure you have error handling to manage unexpected issues. '********************************************************************** Public Function GetDesktopPath() As String Dim strDesktopPath As String Dim objShell As Object On Error GoTo ErrorHandler ' Create an instance of Shell object Set objShell = CreateObject("Shell.Application") ' Get the Desktop folder path strDesktopPath = objShell.NameSpace(&H10&).Self.Path ' Return the path GetDesktopPath = strDesktopPath Exit Function ErrorHandler: MsgBox "Error occurred while retrieving the Desktop path. Error: " & Err.Description, vbCritical GetDesktopPath = "" End Function بالمناسبة لا داعى للقلق من وجود واستخدام "SendKeys" داخل الاكود لانه تم التعامل معها بحرفية تامة كى لا تأثر على حالة الـ Num Lock ImmediateWindowHelper.accdb

النماذج الفرعية: لكل نسخة من النموذج AccTree سيكون هناك نسخة مستقلة من النماذج الفرعية التلاعب بالقيم: يؤثر فقط على النسخة التي تعمل عليها clnClient.Add: يستخدم لتخزين النماذج المفتوحة بحيث يمكن الوصول إليها لاحقا باستخدام معرف النافذة المتغيرات: يمكن استخدام نفس المتغير لإدارة جميع النماذج أو يمكن تعريف متغيرات منفصلة حسب الحاجة

ارجوكى يكون المرفق ابسط قدر ممكن من البساطة بدون اى اضافات

نعم انا أرجع ذلك جدول على ان يبدأ بالبادئة"Usys" ليكون اسمه مثلا كالاتى : UsystblPassInfo وذلك ليكون مخفيا ضمن جداول النظام عن اعين المتطفلين نعم قرأت مقال ذات مرة أن الضغط والاصلاح بشكل متكرر و مستمر وبدون داع قد يضر بقاعدة البيانات والشئ بالشئ يذكر ان استاذى الجليل و معلمى القدير و والدى الاستاذ @jjafferr نسأل الله تعالى أن يرده ويعيده الينا ان شاء الله سالما هانئا ان شاء الله فى أقرب وقت قدم الينا كنز لا يقدر بقدر بثمن فى هذا الموضوع : ------------------------------------- وممكن بعد اذن حضرتك يا باش مهندسة فضلا وكرما وليس أمرا تشاركينا قاعدة البيانات التى تحدثتى عنها والتى تقوم بـ شكر جزبلا لحضرتك , جزاكم الله خيــــرا

جرب المرقق ده https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=229962&key=6be4aebe1bd6693b595feff8e00d6e1f

ممكن سؤال وليه اصلا نموذجين اتنين مع اننا ممكن نعمل نموذج ومعاك فكرتين الاولى : نبدأ بشريط التقدم قبل بيانات الدخول الثانية : نبدأ ببيانات الدخول قبل التقدم LoadingAndLoginformReversal.accdb LoadingAndLoginform.accdb

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 Set db = CurrentDb() If Me.jop.Value <> "محاسب" And Me.jop.Value <> "مستخدم" Then MsgBox "برجاء إدخال كلمة محاسب أو مستخدم فقط.", vbExclamation, "قيمة غير صحيحة" Cancel = True Exit Sub End If If Me.jop.Value = "مستخدم" Then Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfUsers FROM tblUsers WHERE jop = 'مستخدم'") UserCount = rs!CountOfUsers If UserCount >= 3 Then PasswordInput = InputBox("لقد تم إدخال 3 سجلات لمستخدمين. يرجى إدخال كلمة السر لإضافة مستخدم جديد:") If PasswordInput = "" Or PasswordInput <> "123" Then MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة مستخدم جديد.", vbExclamation Cancel = True End If End If rs.Close Set rs = Nothing End If Set db = Nothing End Sub

انا دوخت معاك يا دكتور ومش فاهم كويس يعنى حضرتك تريد الاتى : السماح فقط باستخدام "محاسب" أو "مستخدم". لا يمكن إدخال أكثر من 3 سجلات بوظيفة "مستخدم". يُسمح بعدد غير محدود من سجلات "محاسب". إذا تجاوز إجمالي عدد السجلات 3، يتم طلب كلمة المرور. لو انا كده فهمت صح يكون الكود Private Sub jop_BeforeUpdate(Cancel As Integer) If Me.jop.Value <> "محاسب" And Me.jop.Value <> "مستخدم" Then MsgBox "برجاء إدخال كلمة محاسب أو مستخدم فقط.", vbExclamation, "قيمة غير صحيحة" Cancel = True Exit Sub End If Dim db As DAO.Database Dim rs As DAO.Recordset Dim UserCount As Integer Dim AccountantCount As Integer Dim PasswordInput As String Set db = CurrentDb() Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfUsers FROM tblUsers WHERE jop = 'مستخدم'") UserCount = rs!CountOfUsers rs.Close If Me.jop.Value = "مستخدم" And UserCount >= 3 Then MsgBox "لا يمكن إضافة أكثر من 3 مستخدمين بوظيفة مستخدم.", vbExclamation Cancel = True Exit Sub End If Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfAll FROM tblUsers") UserCount = rs!CountOfAll rs.Close If UserCount >= 3 Then PasswordInput = InputBox("تجاوزت عدد السجلات 3. يرجى إدخال كلمة السر:") If PasswordInput = "" Or PasswordInput <> "123" Then MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة سجل جديد.", vbExclamation Cancel = True Exit Sub End If End If Set rs = Nothing Set db = Nothing End Sub

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

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

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

والكود ده كده لعدد السجلات بقه لو انا قاهم صح استخدمه فى اى مكان بمزاجك Private Sub txtjop_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim UserCount As Integer Dim PasswordInput As String Set db = CurrentDb() Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfAccountants FROM tblUsers") UserCount = rs!CountOfAccountants If RecordCount >= 3 Then PasswordInput = InputBox("لا يمكن إدخال سجل رابع. يرجى إدخال كلمة السر:") If PasswordInput = "" Or PasswordInput <> "123" Then MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة سجل رابع.", vbExclamation Cancel = True End If End If rs.Close Set rs = Nothing Set db = Nothing End Sub

Private Sub txtJob_BeforeUpdate(Cancel As Integer) If Me.txtJob.Value <> "محاسب" And Me.txtJob.Value <> "مستخدم" Then MsgBox "برجاء إدخال كلمة محاسب أو مستخدم فقط.", vbExclamation, "قيمة غير صحيحة" Cancel = True Me.txtJob.SetFocus End If End Sub

طيب ما الافضل تعمل مربع سرد للوظائف بذلك لن يكون اصلا هناك الا الوظائف التى تسمح انت بها من خلال مربع السرد بالنسبة لعدد المستخدمين استخدم نفس الكود السابق ولكن بدون شروط بذلك لما يجد العدد ٣ تظهر الرسالة كل اللى تعمله شيل الجزء بتاع الشرط من الكود اللى هو ده WHERE jop = 'محاسب'" وبكده استخدم الكود مع اى مربع نص لان الشرط بقى عدد سجلات

وعبى يابا

بسيطة جدا استحدم الكود التالى لمربع النص فى الحدث قبل التحديث على اعتبار ان مربع النص اسمه txtjop Private Sub txtjop_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim UserCount As Integer Dim PasswordInput As String Set db = CurrentDb() Set rs = db.OpenRecordset("SELECT COUNT(*) AS CountOfAccountants FROM tblUsers WHERE jop = 'محاسب'") UserCount = rs!CountOfAccountants If UserCount >= 3 And Me.txtjop.Value = "محاسب" Then PasswordInput = InputBox("لا يمكن إدخال محاسب رابع. يرجى إدخال كلمة السر:") If PasswordInput <> "123" Then MsgBox "كلمة السر غير صحيحة. لا يمكن إضافة محاسب رابع.", vbExclamation Cancel = True End If End If rs.Close Set rs = Nothing Set db = Nothing End Sub

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

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

جزاكم الله خيـــرا

طيب مبدئيا كده : الاكواد والدوال هى هى فقط تمت بعض التعديلات الطفيفة جدا جدا جدا قمت باعادة تسمية الدوال للتناسب مع الوظائق الجديدة التى تم اضافتها الوظائف الجديدة فقط تقرأ الارقام بعد العلامة العشرية بمعالجة خاصة بسبب تواجد الرقم صفر بعد العلامة العشرية مباشرة تم اضافة نموذج منشئ الكود للدوال اترككم للتجربة والاستمتماع ان شاء الله بأمر الله تعالى تقريبا انتهى هذا الموضوع نهائيا بإقتراب الافكار والمرفق الى اقرب درجات الكمال . 1- التعامل بشكل صحيح مع عدد المنازل العشرية لكسر العملات المختلفة وامكانية تعديل المنازل لكل عملة من الجدول 2- ضبط صيغ المسميات لكسر العملات تبعا للجنس من خلال المسميات الذكورية و الانثوية وامكانية تعديل الجنس لكل عملة من الجدول 3- ضبط الالفاظ اللغوية تقريبا بالشكل الصحيح أو بأقرب شكل ممكن 4- التحكم فى نوع العملة الافتراضية التى يتم التفقيط لها من الجدول باختيار تنشيط عملة واحدة 5- امكانية التعامل مع اكثر من عمل فى نفس الوقت بأكبر قدر ممكن من المرونة 6- امكانية التعامل مع لغة اخرى غير اللغة العربية بالنسبة لكل الاخطاء يا اللى كانت بالكود بحمد الله تعالى وبفضله تم التأكد من التعامل معها بشكل احترافى تم تحديث المرفقات فى رأس الموضوع بالمشكاركة الاولى ويمكن تحميل المرفقات من هنا او من هناك basHandleNO2Words.zip HandleNumber2Words V2.0.1- Test.zip Text Converter Ascii (v. 3).accdb

تم تعديل المرفقات فى المشاركة الرئيسية التعديلات الجديدة : تفقيط عملات متعددة فى وقت واحدة تفقيط الاعداد فقط بدون بيانات العملات - تم مراعاة تفقيط الاصفار بعد العلامة العشرية مثل (فاصل صفر و صفر و أربعة و عشرون لا غير) للرقم .0024

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

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

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