منتصر الانسي

اعرض الملف أداة تحويل محرر الأكواد للوضع الداكن Dark Theme {سلسلة الأدوات المساعدة المخصصة} هناك الكثير يفضل العمل في بيئة عمل داكنة لإنها تكون مريحة للعين أكثر وكما نعرف فإن طريقة تعيين ألوان محرر الأكواد طريقة طويلة ومعقدة بعض الشيئ لذا أقدم لكم هذه الأداة التي تقوم بتحويل محرر الأكواد VBE للوضع الداكن في جميع تطبيقات أوفيس وليس الأكسس فقط هذه الأداة بسيطة جداً ولا تتطلب إلا نقرة زر فقط قمت بتوضيح طريقة عمل الكود بالتفصيل ليتمكن أي شخص من تغيير الإعدادات التي يرغب بها مع تحياتي صاحب الملف منتصر الانسي تمت الاضافه 08/09/25 الاقسام قسم الأكسيس  

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

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

جرب المرفق قاعدة بيانات.rar

ماشاء الله أعتقد أن المداخلات من @ابو جودي و @jjafferr قد أثرت الموضوع وغطت الطرق الأكثر عملية مع توضيح مزايا وعيوب كل طريقة ولكن وتوضيحا لكلام الاخ @ابو جودي انا استخدم طابعة إفتراضية تقوم بإستخراج التقرير كملف PDF وتعمل مثل الطابعة الحقيقة أما كلامك فمعناه أنك تستخدم الأمر DoCmd.OutputTo وهذا لايعتبر أمر طباعة وإنما امر لإستخراج الكائن بصيغة محددة بحالته كيفما تكون ولو لاحظت فإن الرسالة لاتظهر من الأساس فحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير يتطلب استخدام الأمر DoCmd.OpenReport حتى يتم تفعيله ولكن مثلما أسلفت فهذه المناقشات جميلة لنتعرف كلنا على الطرق المختلفة لحل المشاكل فقد يحتاجها أحدنا يوما ما مع تحياتي

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

مع إحترامي لحل الأخ @ابو جودي فالمسألة أبسط من كذا كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 ليصبح بهذا الشكل Private Sub Report_NoData(Cancel As Integer) 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 End Sub مع تحياتي

من إطلاعي على الملف فأنت تريد أن الصور التي بإسم CompanyLogo و StampLogo أن تكون عامة لكل الفروع والصور BranchLogo تكون متغيرة بحسب الفرع أليس كذلك؟ إذا كان الوضع بهذا الشكل فيجب عليك عدم ربط الصورتين CompanyLogo و StampLogo بالحقل لأنه يفترض أن الشركة واحدة عموما قمت بتعدبل الملف جرب فتح التقرير بزر المعاينة للسجلين الاول والثاني وكذا فتحه مباشر بالنقر المزدوج على التقرير هل هذا التعديل هو ماتطلبه أم شيئ آخر لأن شرحك غير واضح مع تحياتي DDCompanyLogos.rar

يجب إضافة المرجع Microsoft Office 16.0 Object Library كما بالصور أدناه من قائمة Tools إختر References انزل إلى أن تصل للمرجع Microsoft Office 16.0 Object Library (القائمة مرتبة أبجديا وسيكون الوصول للمرجع سهل) قم بتحديده واتقر OK تحياتي

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

مثال الاخ @Foksh النموذج Eye1 رائع خصوصا بعد تعديل الأخت @hanan_ms حيث أصبحت حركة العين أكثر سلاسة عند تحريك الماوس أما النموذج الخاص بالأخت @hanan_ms الذي بإسم Eye2 كلما احرك الماوس عليه تظهر لي رسالة الخطأ الموضحة بالصورة فهل تظهر الرسالة عند البقية أم أنها مشكلة خاصة بي فقط تحياتي

ألمهم أن المشكلة حلت لكن لدي تصحيح بسيط أنا قلت تعديل التنسيق إلى هذا الشكل #.00 علامة الهاشتاغ مع نقصة وصفرين وانت قمت بعمل التنسيق بهذا الشكل #,00 علامة الهاشتاغ مع فاصلة وصفرين نظرا ً لأن المشكلة هذه لاتظهر عندنا فلو أمكن تعديل تنسيق الحقل في الجدول بالشكل الذي إقترحته لك وتخبرنا هل ظلت المشكلة نفسها أم ظهر خطأ آخر جديد أم أنها نجحت حتى نستفيد مع تحياتي

طالما نوع الحقل نصي فالحل بسيط أضفت تقرير لمثال الأخ @Foksh تظهر فيه القيم السالبة باللون الاحمر مع تحياتي TimeMin.rar

كما يلاحظ من الصورة رسالة الخطأ ترد الخطأ للفاصلة وتنسيق الرقم يؤكد هذا لذا فأنا أعتقد أن المشكلة سببها هو تنسيق الرقم قمت بتعديل تنسيق الحقل في الجدول بدل أن كان Fixed جعلته #.00 حتى أجبره أن يظهر العلامة العشرية كنقطة وليس فاصلة ان شاء الله تنحل المشكلة اما إذا إستمرت فقد تكرمت أنت بالحل الأخير تحياتي

اعتقد أني عرفت المشكلة جرب المثال الان وأخبرنا إذا ظهرت الرسالة أم لا مع تحياتي baseM11.rar

واجهتني مشكلة واحدة أنه عند إغلاق النماذج من علامة X تتبقى شاشة أكسس بدون أي مجال لإغلاقها إلا عن طريق Task Manager

مرفق لك مثالك بعد التعديل قمت بإضافة جدول tblDates والإستعلام qryDates النتيجة النهائية ستجدها في الاستعلام Query1 أرجو أن يكون هو ماتبحث عنه مع تحياتي Database1.rar

الصراحة أن هذه المشكلة مثل المخدر الذي لا يستطيع الشخص الإقلاع عنا إلا بحلها وكلما قلت سأقلع عن التفكير فيها أرجع لها وبقوة توصلت أخيرا لدالة تحويل تشية دوال التحويل المضمنة (CStr أو CDbl أو CDate) ولكنها بإسم CSql تقوم بتحويل جميع أنواع البيانات لتلائم أوامر Sql وللمفاجأة نجحت في العمل كل الذي سويته أني عدلت [date1] الى cSql([dat1]) وأزلت علامتي # لأن الدالة ستقوم بهذا العمل (لم أقم بتطبيقها مع حقل [user_id] لأنها تعرفت عليه كرقم وبالتالي لم تضيف علامة التنصيص له فأبقيت الحال على ماهو عليه) وبالفعل كانت النتيجة كما هو متوقع والسبب في ذلك في إعتقادي أن الدالة قامت بمراعاة الإعدادات الإقليمية عند قراءة التاريخ فالتاريخ #03/06/2025# في بلدات تعني اليوم الثالث من الشهر السادس وفي بلدان اخرى تعني اليوم السادس من الشهر الثالث وهذا هو سبب الإلتباس المنطقي للمشكلة في إعتقادي عموما ارفقت الملف الأصلي بعد تطبيق هذه الدالة ليكون حل من ضمن الحلول الذي قام بها بقية الأساتذة مع تحياتي Public Function cSQL(ByVal varValue As Variant) As String On Error GoTo ERRORHANDLER ' تحقق إذا كانت قيمة فارغة If IsNull(varValue) Then cSQL = "NULL" Exit Function End If Select Case VarType(varValue) ' منطقية Case vbBoolean ' يستخدم أكسس -1 لـ TRUE و 0 لـ FALSE cSQL = IIf(varValue, "-1", "0") ' الأرقام 64 بت Case vbByte, vbInteger, vbLong, vbLongLong ' الأعداد الصحيحة - تحويله لنص مباشرة cSQL = CStr(varValue) ' ' الأرقام 32 بت ' Case vbByte, vbInteger, vbLong ' ' الأعداد الصحيحة - تحويله لنص مباشرة ' cSQL = CStr(varValue) Case vbSingle, vbDouble, vbCurrency ' تحويل إلى تنسيق SQL العشري باستخدام فاصل النقطة cSQL = Replace(Format(varValue, "0.######"), ",", ".") ' التاريخ Case vbDate ' تنسيق التاريخ/الوقت بنمط أكسس If TimeValue(varValue) = 0 Then cSQL = "#" & Format(varValue, "yyyy-mm-dd") & "#" Else cSQL = "#" & Format(varValue, "yyyy-mm-dd hh:nn:ss") & "#" End If ' النص Case vbString Dim str As String Dim dat As Date Dim parts() As String Dim datePart As String, timePart As String str = Trim(varValue) ' 1. سلسلة نصية بتنسيق SQL بالفعل (على سبيل المثال، #2025-04-23#) If Left(str, 1) = "#" And Right(str, 1) = "#" Then cSQL = str Exit Function End If ' 2. رقم وليس تاريخ (على سبيل المثال، "3.14") If IsNumeric(str) And Not IsDate(str) Then cSQL = Replace(Format(CDbl(str), "0.######"), ",", ".") Exit Function End If ' 3. تاريخ قصير وفقاُ الإعدادات المحلية If InStr(str, ".") > 0 Then parts = Split(str, " ") datePart = parts(0) If UBound(parts) > 0 Then timePart = parts(1) Else timePart = "" Dim datePieces() As String datePieces = Split(datePart, ".") If UBound(datePieces) = 2 Then Dim dd As Integer, mm As Integer, yyyy As Integer dd = Val(datePieces(0)) mm = Val(datePieces(1)) yyyy = Val(datePieces(2)) If yyyy < 100 Then yyyy = yyyy + IIf(yyyy < 30, 2000, 1900) End If If IsDate(DateSerial(yyyy, mm, dd)) Then dat = DateSerial(yyyy, mm, dd) If Len(timePart) > 0 And IsDate(timePart) Then dat = dat + TimeValue(timePart) cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" Else cSQL = "#" & Format(dat, "yyyy-mm-dd") & "#" End If Exit Function End If End If End If ' 4. سلسلة نصية للوقت فقط (على سبيل المثال، "23:15") If InStr(str, ":") > 0 And Not InStr(str, ".") > 0 Then If IsDate(str) Then dat = CDate(str) If DateValue(dat) = #12:00:00 AM# Then dat = Date + TimeValue(dat) cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" Exit Function End If End If End If ' 5. سلسلة تصية تمثل التاريخ/الوقت كاملا If IsDate(str) Then dat = CDate(str) If TimeValue(dat) = 0 Then cSQL = "#" & Format(dat, "yyyy-mm-dd") & "#" Else cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" End If Exit Function End If ' 6. البديل الافتراضي: السلسلة النصية الخاصة بالهروب لـ SQL cSQL = "'" & Replace(str, "'", "''") & "'" ' غير معروف Case Else ' البديل الافتراضي للأنواع الغير معروفة If IsNumeric(varValue) Then cSQL = Replace(Format(varValue, "0.######"), ",", ".") Else cSQL = "'" & Replace(CStr(varValue), "'", "''") & "'" End If End Select Exit Function ERRORHANDLER: ' الرجوع إلى الخطأ - إرجاع سلسلة الهروب cSQL = "'" & Replace(CStr(varValue), "'", "''") & "'" End Function d8.rar

نفضل المثال بعد التعديل مثال.rar

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

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

يمكنك ذلك عن طريق القوائم المختصرة قمت بتعديل مثالك حيث قمت بإضافة وحدة نمطية بإسم mdlPrintMenu تقوم بإنشاء قائمة مختصرة بإسم PrintMenu ومن خاصية Shortcut Menu Bar الخاصة بالتقرير (لا أتذكر الإسم بالعربي تماما ولكن يمكن أن يكون شريط قائمة الاختصارات) نقوم بإختيار PrintMenu من القائمة إن شاء الله يكون هذا الحل هذا هو الحل الذي تبحث عنه مع تحياتي LAb.rar

اقتراحي ان يتم تحويل الوقت الى ثواني لانها أدنا وحدة للوقت (هذه دالة تقوم بالتحويل) Public Function fncTimeToSec(varTime As Variant) As Double On Error GoTo OnErrors Dim curTime1 As Double If IsNull(varTime) Or varTime = "" Then fncTimeToSec = 0 Else If Len(varTime) > 5 Then curTime1 = CLng(Left(varTime, 2)) * 3600 curTime1 = curTime1 + CLng(Mid(varTime, 4, 2)) * 60 curTime1 = curTime1 + CLng(Mid(varTime, 7, 2)) Else curTime1 = CLng(Left(varTime, 2)) * 60 curTime1 = curTime1 + CLng(Mid(varTime, 4, 2)) End If fncTimeToSec = curTime1 End If ToExit: Exit Function OnErrors: fncTimeToSec = 0 Resume ToExit End Function ثم نقوم باجراء العملية الحسابية ثم نعيد تحويلها الى وقت بإستخدام هذه الدالة Public Function fncSecToTime(dblSeconds As Double) As String On Error GoTo OnErrors Dim curTime1 As Double If IsNull(dblSeconds) Or dblSeconds = 0 Then fncSecToTime = 0 Else curTime1 = Int(dblSeconds) fncSecToTime = Format(Int(curTime1 / 3600), "00") _ & ":" & Format(Int((curTime1 Mod 3600) / 60), "00") _ & ":" & Format((curTime1 Mod 3600) Mod 60, "00") End If ToExit: Exit Function OnErrors: fncSecToTime = 0 Resume ToExit End Function جرب وإن شاء الله تنجح مع تحياتي

تم تعديل الكود في مثالك مع تحياتي LAb.rar