Foksh

اخي الكريم العائد لك هنا هو نتيجة MySQL ( الإستعلام ) على سبيل المثال من باب التوضيح لهذا السطر :- Dim i As Integer For i = 1 To 5 Debug.Print "Current value of i: " & i Next i فأن النتيجة للحلقة التكرارية هذه ستكون في Ctrl+G = Current value of i: 1 Current value of i: 2 Current value of i: 3 Current value of i: 4 Current value of i: 5 المقصود هو انه يمكنك استدعاءها حيثما تريد لرؤية نتيجة ما تريد وللتحقق من النتيجة التي عاد لك بها .. لا أعلم إن كان شرحي لها هو ما تقصده .

وما المانع في ذلك ، بما انه لكل سجل رقم ID فريد !!!!!

اخي الكريم @بوكفوس عبدالسلام وعليكم السلام ورحمة الله وبركاته .. الموضوع بسيط جداً اخي ولا يحتاج لماكرو لتحديد الشرط بهذا الأسلوب ، جعلت الشرط الذي تريده في الاستعلام الخارجي ، وجعلت مصدر سجلات النموذج نفس الاستعلام بدون شرط ، ولكنه استعلام داخلي .. تفضل الملف بعد التعديل :- الشهادة الإدارية.accdb

أهلا أستاذ @kanory >> يسعدني مرورك العطر أولاً ثانيا لم أتابع الموضوع الذي أشرت إليه لأني فعلاً لم ابحث عن هذه المواضيع في المنتدى .. وثالثاً وهو المهم .. لا يتم استخدام اي ايميل او باسوورد لأي حساب داخل الأكواد .. يلزم المبرمج رابط الملف النصي فقط لإضافته في جدوله .. والباقي عمل الكود .. دعمت الفكرة بأن يكون التحميل من ملف خارجي يتم استخراجه من داخل الجدول المرفق في ملفي . ( فكرة جديدة ) في فكرتي لم ولن ولا اعتمد على برامج تلزم المبرمج بتثبيت برامج في جهاز العميل . لا يوجد روابط داخل الأكواد ، كلها يتم استدراجها وجلبها إل الجدول بشكل خفي منحت المستخدم فكرة الكشف التلقائي عن التحديثات حال وجودها . ففي الجدول هناك حقل Auto_Check من خلاله يستطيع المبرمج استغلاله بحيث :- Private Sub Form_Load() DoEvents If Check_Auto = -1 Then Me.TimerInterval = 1000 Else Me.TimerInterval = 0 End If End Sub Private Sub Form_Timer() Me.TimerInterval = 0 CheckForUpdate End Sub التعامل مع معلومات التنزيل للتحديث بإحترافية ( بحيث يتم عرض شريط تحميل حقيقي لحجم الملف الذي تم تحميله وعرض سرعة الإنترنت والوقت المتبقي لإكمال عملية التحديث ) والعديد موجود في الملف الذي يتم استخراجه لتنفيذ عملية التحديث الصامت بالنسبة لفكرتي مختلفة تماماً إلا أنها في الهدف متشابهة .

نرجو من الأخ @محمد التميمي ، متابعة مواضيعه بإغلاقها باختيار أفضل إجابة كي لا تبقى معلقة - عند إيجاده الحل طبعاً .

ما رأيك بهذا الإقتراح ، لتلافي استخدام DCount المتكرر .. On Error GoTo Ops Dim recordCount As Long recordCount = DCount("[Id]", "[Add_Custorm_QR]") If recordCount = 0 Then Me.cmdPrevious.Enabled = False Me.cmdFirst.Enabled = False Me.cmdLast.Enabled = False Me.cmdNext.Enabled = False Me.cmDelete.Enabled = False Else Me.cmDelete.Enabled = True Me.cmdPrevious.Enabled = (txtRec > 1) Me.cmdFirst.Enabled = (txtRec > 1) Me.cmdLast.Enabled = (txtRec < recordCount) Me.cmdNext.Enabled = (txtRec < recordCount) End If Exit Sub Ops: MsgBox "Error: " & Err.Description & " (" & Err.Number & ")" Exit Sub استخدامت المتغير txtRec لمقارنة المواضع بدل ما يتم استدعاء DCount المتكرر

بالعكس استاذنا الفاضل @Eng.Qassim ، يسعدني تعدد الإجابات وطرح الأفكار المتنوعة 😇 . لا تشغل بالك ، انتهى الأمر بأجابتك وإجابتي كأنهما واحد 🤗 .

تبارك الرحمن ، ما شاء الله ، عمل إبداعي يتحدث عن نفسه . عاش الصوت وصاحبه والمايكات الجديدة .. التصميم والألوان شيء يبعث الراحة في النفس .. دقة في التصميم والتنفيذ .. وسهولة العمل عليه شيء في منتهى االروعة 👌🏻 عاشت ايدينك مهندسنا الغالي

كل الإحترام والتقدير للأستاذ @Eng.Qassim ، ولا أشك في قدرته على ما تفضل به .. لكن اخي الكريم يبدو انك لم تمعن في المشاركات ولمن كان الحل ، في ملفك المرفق الحل الذي اقترحته عليك في مشاركتي هذه :- فكيف نسبت الحل باختيارك لأستاذنا الكريم المهندس قاسم !!!!!!!!

اخي الكريم ، اقصد هل وجدت الحل من هذه المشاركة :- أم من هذه المشاركة :- وارسل لي الملف الذي يعمل معك لأرى الفكرة وأتعلم طريقة الحل

من اي ملف هذه النتيجة يا صديقي !!!!!!!!!!!!!!!!!!!! للتدقيق

غفر الله لك ولوالديك .. ولكم بالمثل وأكثر مما دعيتم مهندسنا الغالي ,, بالنسبة لطلبك فابشر بهما ,, في التالي سأقوم بالتعديل لجعل الموضوع أكثر مرونة باختيار الدولة التي تريدها ، ولكن بعد تجربتها على عدة أجهزة لضمان نجاحها . أما بخصوص ملف الباتش فهو فعلاً يتم انشاؤه في مجلد %TEMP% داخل الويندوز ليتم التعديل وتمرير الفكرة من خلال الجملة التالية .WriteLine "control.exe intl.cpl,, /f:""C:\Windows\System32\intl.cpl""" لكني سأزودك به منفصلاً

تم تعديل الاستعلام كالآتي :- SELECT Max([يومية المشاريع].ID) AS MaxOfID, [يومية المشاريع].المشروع, Max([يومية المشاريع].[المقننين قرار (70)]) AS [MaxOfالمقننين قرار (70)], Max([يومية المشاريع].[الغير مقننين قانون (12)]) AS [MaxOfالغير مقننين قانون (12)], Max([يومية المشاريع].[عمال المياومة]) AS [MaxOfعمال المياومة], Max([يومية المشاريع].الاجمالي) AS MaxOfالاجمالي, Last([الايراد والمصروفات المشاريع].الاشهر) AS Lastمنالاشهر, First([الايراد والمصروفات المشاريع].الاشهر) AS Firstمنالاشهر, Sum([الايراد والمصروفات المشاريع].الايرادات) AS SumOfالايرادات, Sum([الايراد والمصروفات المشاريع].المصروفات) AS SumOfالمصروفات, Sum([الايراد والمصروفات المشاريع].[الفائض/العجز]) AS [Sumمنالفائض/العجز], IIf([SumOfالايرادات]>[SumOfالمصروفات],[Sumمنالفائض/العجز],IIf([SumOfالايرادات]=[SumOfالمصروفات],0)) AS الفائض, IIf([SumOfالايرادات]<[SumOfالمصروفات],[Sumمنالفائض/العجز],IIf([SumOfالايرادات]=[SumOfالمصروفات],0)) AS العجز, [بداية التاريخ] AS Minمنالاشهر, [نهاية التاريخ] AS MaxOfالاشهر FROM [يومية المشاريع] INNER JOIN [الايراد والمصروفات المشاريع] ON [يومية المشاريع].ID = [الايراد والمصروفات المشاريع].ID1 WHERE ((([الايراد والمصروفات المشاريع].الاشهر)>=[بداية التاريخ] And ([الايراد والمصروفات المشاريع].الاشهر)<[نهاية التاريخ])) GROUP BY [يومية المشاريع].المشروع, [بداية التاريخ], [نهاية التاريخ]; تفضل الملف المرفق بعد التعديل :- الايرادات والمصروفات_.zip

هل جربت مثلاُ 2023 !!

سؤال جميل ، العمل جاري لتعديل الملف الوسيط ليقرأ امتداد قاعدة البيانات الأساسية دون تدخل برمجي .. لكن حالياً ولتجربة الفكرة فالإمتداد المتعامل معه هو Accdb . انتظر التحديث القادم ان شاء الله .

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) أشارككم اليوم حلاً برمجياً لمشكلة شائعة تواجه مطوري و مبرمجي تطبيقات آكسيس عند التعامل مع اللغة العربية . المشكلة تتمثل في الحاجة لتغيير لغة النظام (System Locale) إلى العربية لضمان عرض النصوص العربية بشكل صحيح في التطبيق ، وضمان عمل المشروع دون مشاكل . 🎯 المشكلة: - عدم ظهور النصوص العربية بشكل صحيح في بعض أجزاء التطبيق - الحاجة المتكررة لتغيير إعدادات النظام يدوياً - صعوبة شرح الخطوات للمستخدمين النهائيين ✨ الحل: قمت بتطوير دالة برمجية تقوم بـ: 1. فحص لغة النظام الحالية 2. تغيير لغة النظام إلى العربية بشكل تلقائي 3. ضبط جميع الإعدادات الضرورية (CodePage, Locale, Keyboard Layout) 4. إعادة تشغيل النظام بشكل آمن لتطبيق التغييرات 🔑 المميزات: - تنفيذ التغييرات بنقرة زر واحدة - رسائل واضحة باللغة الإنجليزية للمستخدم - معالجة الأخطاء بشكل احترافي - تأكيد موافقة المستخدم قبل إجراء التغييرات - إتاحة وقت كافٍ لحفظ الملفات قبل إعادة التشغيل 📝 ملاحظات هامة: - سيتم إعادة تشغيل الجهاز بعد تطبيق التغييرات - الكود يعمل على جميع إصدارات Windows الحديثة وهذه صورة توضيحية للخطوات التي كان على المستخدم العادي أو المبرمج تنفيذها حتى يتلافى مشكلة اللغة العربية :- الكود المستخدم في المديول :- Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetUserDefaultUILanguage Lib "kernel32" () As Long Private Declare PtrSafe Function GetACP Lib "kernel32" () As Long #Else Private Declare Function GetUserDefaultUILanguage Lib "kernel32" () As Long Private Declare Function GetACP Lib "kernel32" () As Long #End If Private Const MSG_CHANGE_LANGUAGE As String = "Your program will not function correctly; the unicode language must be changed to Arabic. Would you like to proceed with changing the unicode language?" Private Const MSG_RESTART_NOTE As String = "Note: The computer will restart after the change" Private Const MSG_TITLE As String = "Change System Language" Private Const MSG_RESTART_SOON As String = "The computer will restart in 15 seconds" Private Const MSG_SAVE_FILES As String = "Please save all open files" Private Const MSG_CANT_RUN As String = "The project cannot run without changing the system language to Arabic" Private Const MSG_ERROR As String = "System error occurred. Please contact your administrator" Private Function IsArabicLanguage() As Boolean Dim CodePage As Long CodePage = GetACP() IsArabicLanguage = (CodePage = 1256) End Function Public Function SetArabicLocale() As Boolean On Error GoTo ErrorHandler If Not IsArabicLanguage() Then Dim response As VbMsgBoxResult response = MsgBox(MSG_CHANGE_LANGUAGE & vbCrLf & MSG_RESTART_NOTE, _ vbQuestion + vbYesNo + vbDefaultButton2, _ MSG_TITLE) If response = vbYes Then Dim fso As Object Dim txtFile As Object Dim filePath As String filePath = Environ$("TEMP") & "\ChangeToArabic.bat" Set fso = CreateObject("Scripting.FileSystemObject") Set txtFile = fso.CreateTextFile(filePath, True) With txtFile .WriteLine "@echo off" .WriteLine "chcp 1256" .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v Default /t REG_SZ /d 00000401 /f" .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v InstallLanguage /t REG_SZ /d 00000401 /f" .WriteLine "reg add ""HKCU\Control Panel\International"" /v LocaleName /t REG_SZ /d ar-JO /f" .WriteLine "reg add ""HKCU\Control Panel\International"" /v Locale /t REG_SZ /d 00000409 /f" .WriteLine "reg add ""HKCU\Control Panel\International"" /v sLanguage /t REG_SZ /d ARA /f" .WriteLine "reg add ""HKCU\Control Panel\International"" /v sCountry /t REG_SZ /d Jordan /f" .WriteLine "reg add ""HKCU\Control Panel\International"" /v iCountry /t REG_SZ /d 962 /f" .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage"" /v ACP /t REG_SZ /d 1256 /f" .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage"" /v OEMCP /t REG_SZ /d 1256 /f" .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage"" /v MACCP /t REG_SZ /d 10004 /f" .WriteLine "reg add ""HKCU\Keyboard Layout\Preload"" /v 1 /t REG_SZ /d 00000401 /f" .WriteLine "control.exe intl.cpl,, /f:""C:\Windows\System32\intl.cpl""" .WriteLine "timeout /t 5" .WriteLine "shutdown /r /t 15 /c ""سيتم إعادة تشغيل الجهاز بعد ( 15 ثانية ) لتطبيق إعدادات اللغة العربية"" /f" End With txtFile.Close Dim shellApp As Object Set shellApp = CreateObject("Shell.Application") shellApp.ShellExecute filePath, "", "", "runas", 1 MsgBox MSG_RESTART_SOON & vbCrLf & MSG_SAVE_FILES, vbInformation SetArabicLocale = True Else MsgBox MSG_CANT_RUN, vbCritical SetArabicLocale = False End If Else SetArabicLocale = True End If Exit Function ErrorHandler: MsgBox MSG_ERROR, vbCritical SetArabicLocale = False End Function طبعاً رسالة التنبيه تم كتابتها باللغة الإنجليزية . في متغيرات متعددة ( السبب هو إحدى المحاولات للكتابة بالعربية مع تشفير النص ( Unicode ) ) . ولكني تجاهلت الفكرة لاحقاً . الآن يمكنك استدعاء الدالة في أول نموذج لك بالشكل التالي :- SetArabicLocale عند وجود اللغة العربية هي لغة الترميز في نسخة الويندوز ، لن تظهر لك رسالة ضرورة تغيير لغة الترميز الى العربية . ولم اقم بإضافات كبيرة خارج إطار الموضوع ، وللمبرمج حرية التعديل والإستفادة من الكود حيثما وكيفما يشاء . الملف المرفق مفتوح المصدر 👈 [ LanguageCheck.accdb ]

المشكلة انه في الحقول الرقمية يجب أن تكون القيمة الإفتراضية = 0 (من وجهة نظري) ، وفي مشروع أخونا @كريمو2 ، للأسف لديه حقول فارغة = Null أو "" وهذا يربك العمليات الحسابية حتى عند استخدام NZ على سبيل المثال مع كثرة السجلات والشروط .... إلخ . فاقترحت على نفسي الحيلة ليس إلا ,

تنسيق التاريخ في الحقل داخل الجداول ( 7/1/2024 ) وليست ( 1/7/2024 ) ثم انه لا يوجد لديك مشاريع توافق 11/1/2024 ، فسيتم جلب القيم بين التاريخين . هذا من جهة . ومن جهة ثانية القيمة الافتراضية لمربعات النص التي يتم جلب قيم التاريخ فيها على سبيل المثال =[Forms]![استعلام عن اجمالي الصناديق]![lastOfالاشهر] هنا سيتم جلب آخر قيمة وليست القيمة التي أدخلتها في التعليمة اعتقد هذه مشكلتك

طيب ، جرب هذه الحيلة . 't9 Me.t9 = Nz(DSum("[Loan_Made]", "[tbl_Loans]", "Year ([Auto_Date])=" & Me.txtYear & " And [Loan_ID] > 0 "), 0) - Nz(DSum("[Payment_Made]", "[tbl_Loans]", "Year ([Auto_Date])=" & Me.txtYear & " And [Loan_ID] > 0 "), 0) If Me.t9 = 0 Then Me.Lblt9 = 0 Else MySQL = "" MySQL = "Select DISTINCT(Employeeid) From tbl_Loans" MySQL = MySQL & " Where " & "Year ([Auto_Date])=" & Me.txtYear & "And [Loan_ID] > 0 And ([Loan_Made]-[Payment_Made])=0" ' - Nz(DSum("[Payment_Made]", "[tbl_Loans]", "Year ([Auto_Date])=" & Me.txtYear - 1 & "And [Loan_Type] <> 'Inkhirat'"), 0) Set rst = CurrentDb.OpenRecordset(MySQL) Me.Lblt9 = rst.RecordCount End If 'T9E Me.t9e = Nz(DSum("Nz([Loan_Made], 0)", "[tbl_Loans]", "Year([Auto_Date])=" & Me.txtYear - 1 & " And [Loan_ID] > 0"), 0) - Nz(DSum("Nz([Payment_Made], 0)", "[tbl_Loans]", "Year([Auto_Date])=" & Me.txtYear - 1 & " And [Loan_ID] > 0"), 0) If Me.t9e = 0 Then Me.Lblt9e = 0 Else MySQL = "" MySQL = "SELECT DISTINCT(Employeeid) FROM tbl_Loans WHERE Year([Auto_Date])=" & Me.txtYear - 1 & " And [Loan_ID] > 0" Set rst = CurrentDb.OpenRecordset(MySQL) Me.Lblt9e = rst.RecordCount End If

الآن من خلال معرفتك ببيانات مشروعك ، ما النتيجة الصحيحة للعام 2024 ، والعام 2025 ؟؟ فقط من أجل تلافي كثرة التجارب بيننا ولإكتساب الوقت .

أخي الكريم @سيد رجب ، انت ما شاء الله 03 عضو مميز ، برأيك هل الجملة التي شرحت بها طلبك كافية و واضحة لمن سيقرأ ويلقي نظرة على ملفك ؟؟ أكرمك الله أن لا تبخل علينا بشرح وافي وكافي ، وتحديد اين تكمن المشكلة ( النموذج أو الاستعلام ... إلخ ) كونك ارسلت ملف المشروع كامل ( على ما اعتقد ) .

على فكرة هذا ليس ملف مرفقك لقاعدة بيانات ، بل ملف فيديو

بما أنه هناك جزء قد تحقق ، فإننا ندور حول الحل المناسب ، لأنني خارج العمل حالياً وبعيد عن الكمبيوتر ، سنتابع بأقرب وقت

طيب ، جرب تعديل بسيط كالآتي .. Me.Lblt9e = Nz(DCount("EmployeeID", "(SELECT DISTINCT EmployeeID FROM tbl_Loans WHERE Year([Auto_Date]) = " & Me.txtYear - 1 & " And [Loan_ID] > 0)", ""), 0) أو لنجرب الحل الثاني استخدام Recordset مع DISTINCT .. Dim MySQL As String Dim rst As DAO.Recordset MySQL = "SELECT DISTINCT EmployeeID FROM tbl_Loans WHERE Year([Auto_Date]) = " & Me.txtYear - 1 & " And [Loan_ID] > 0" Set rst = CurrentDb.OpenRecordset(MySQL) Me.Lblt9e = rst.RecordCount أو الحل الثالث مع الدالة DSum .. Me.Lblt9e = Nz(DSum("IIF([Loan_Made] - [Payment_Made] = 0, 1, 0)", "tbl_Loans", "Year([Auto_Date]) = " & Me.txtYear - 1 & " And [Loan_ID] > 0"), 0) ما لم تقم بالتجربة لجميع الحلول ، فلن تصل إلى الحل والهدف 🤗