كل الانشطه

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

التحديث الجديد من مرسال الواتس أب - الإصدار الثاني . يحتوي على الإضافات والتحسينات التالية :- 1️⃣ التحسينات :- تحسين التعامل مع المرفقات الأكثر من مرفق واحد ، بحيث يتم التعامل معها دفعة واحدة بدلاً من التعامل مع كل مرفق بشكل مستقل ( تقليل الوقت ) . تحسين عمليات المحاكاة للوحة المفاتيح للصق الرسالة والملفات داخل تطبيق واتس أب سطح المكتب . 2️⃣ الإضافات الجديدة :- إنشاء جداول الخدمة ( عددها 3 ) بشكل تلقائي . إضافة ميزة الإستيراد من ملفات VCF ( النسخة الإحتياطية من قائمة الأسماء من الجوال ) . بحيث يتم استيراد الأرقام والأسماء الى جدول Tbl_Contacts ، من خلال زر ، مع دعم التعامل مع الترميزات والتشفيرات المختلفة . وأيضاً الأرقام يتم تحويلها إلى صيغة دولية تلقائيًا (مثلاً: 079xxxx → +96279xxxx) . إضافة ميزة إنشاء جهة اتصال جديدة ( قيد التطوير للأفضل ) ، من خلال الزر . إضافة ميزة "إرفاق التوقيع مع الرسالة" . ويمكن التحكم بها من خلال جدول الإعدادات Tbl_SendSettings . إضافة ميزة الإرسال من دفتر العناوين ( متعدد الإختيار ) ، أو ادخال رقم هاتف بشكل يدوي . عند ادخال رقم هاتف يدوي ( محلي ) بدون مفتاح الدولة ، يتم قراءة قيمة رمز الدولة الإفتراضي من الجدول Tbl_SendSettings الخاص بالإعدادات . وعليه فسلت بحاجة لإضافة مفتاح الدولة المحلية بشكل يدوي وإلزامي . إضافة ميزة تقييد مفتاح الإيموجي من خلال جدول الإعدادات . فمنح أو رفض الصلاحية بالوصول اليه . ( قيد التطوير بحيث يتم المنع حتى من خلال لوحة المفاتيح ) . إضافة ميزة تحديد أنواع الملفات المسموح للمستخدم بإرسالها في جدول الإعدادات نفسه . إضاقة التحكم بفترة الإنتظار بين الرسالتين عند الإرسال المتعدد ( بالثواني - القيمة الإفتراضية = 2 ) . إضافة ميزة التحكم بالحد الأقصى لحجم الملفات المرفقة ( فردي أو أكثر من مرفق ) من خلال جدول الإعدادات أيضاً . إضافة رابط لتحميل نسخة برنامج واتس أب سطح المكتب من مصدره على موقع Whatsapp ، من خلال الزر . إضافة ميزة الحفظ التلقائي للأرقام الغير مخزنة في دليل الهاتف ( الجدول Tbl_Contacts ) . بحيث يتم تعريف الرقم بأنه "غير معروف" . وفي التعديلات اللاحقة سيتم إضافة ميزات لها . جميع الرسائل المرسلة ( الناجحة والغير ناجحة ) سيتم تخزينها في الجدول Tbl_Message . أيضاً في التعديلات اللاحقة سيتم إضافة ميزات لها . 3️⃣ صور الواجهة الجديدة :- 4️⃣ تحميل الإصدار الجديد :- WhatsApp Sender 2025.zip

ممكن تدخل بنفسك من هنا 🙂👈>>>>>>

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

تفضل برنامج تصميم سريع لعله يفي بالغرض أجازات 2.xlsm

حياكم الله ان شاء الله غدا ساعمل فيديو تعريفي مفصل وشرح موقع ottokit وهذا موقع حديث طبعا يفتقد الى كثير من المهارات لكن ميزته انه بدون اكواد تستطيع انشاء mcp server

. هناك عدة طرق للتعامل مع هذا التأخير: أ. يجب اعادة النظر في الاستعلام ، ومن متابعتي لردودك ، فأنت عندك هوس/ولع غير طبيعي في الكود ، بينما الاستعلام هو العمود الفقري لقواعد البيانات ، وهو الاسرع. فيجب النظر في تحويل الكود الى استعلامات ، وقد يكون عليك استبدال الكود الواحد الى استعلام واحد اثنين عشرة ... لا يهم ، المهم هو سرعة البرنامج ، ب. او تصدير نتائج هذا الاستعلام الى جدول ، ويكون الجدول هو مصدر بيانات النموذج/التقرير ، فالتأخير سيكون مرة واحدة فقط (عند تصدير الاستعلام ومعالجته الحسابات المعقدة ، الى الجدول) : بما ان الاكسس لا يستطيع عمل اكثر من شيء واحد في نفس الوقت ، اي انه ينتظر حتى تكتمل عمليه معينة ، حتى يقوم بعملية اخرى. مثلا ، اذا اردت عند فتح البرنامج ان يقوم اكسس بتصدير بيانات اسنعلامك البطئ الى جدول ، فعند نقرك زر التصدير ، فلا تستطيع عمل شيء آخر في الاكسس الى ان ينتهي العمل من التصدير ، لذا وبعد النقر على زر التصدير ، اظهر رسالة للمستخدم بترك البرنامج يعمل ، ولما ينتهي البرنامج من التصدير ، تستطيع استخدامه (اعطيه فرصة يشرب قهوة الصباح 🙂 ). الطريقة الاخرى ، والتي لن تجد احد يتكلم عنها (لأنها غير مألوفة) ، بأن تشغل برنامج اكسس آخر (رقم2) والذي فيه الاستعلام البطئ ، فيشغل الاستعلام بأخذ بياناته من برنامجك ، وتصدير البيانات الى جدول ، وفي هذا الوقت وبينما يعمل رقم2 ، يستطيع مستخدمين رقم1 من العمل بطريقة عادية ، ثم يستعملون بيانات الجدول. بمعنى آخر ، اجعل البرامج تشتغل بطريقة متوازية. ولكني اعتقد ان حل التأخير في النقطة أ. وبعد اتباع الطريقة الصحيحة في عمل الاستعلام ، معظم تأخير الاستعلامات هي في الفرز والتصفية ، وحتى اذا عملت فهرسة لحقل ثم في الاستعلام استعملت بيانات الحقل بطريقة اخرى ، فانت في الواقع لا تستفيد من فهرست الحقل ، مثلا عندك حقل تاريخ مفهرس myDate ، ثم قمت في الاستعلام بطلب السنة: Y: Year([myDate]) وعملت له فرز او تصفية لسنة معينة (مثلا 2010) ، فانت في الواقع لا تستفيد من فهرست الحقل ، لذا فالحل هو استعمالك التاريخ كما هو في الحقل ثم عمل التصفية بنفس طريقته ، مثل: myDate>31-12-2009 and myDate<1-1-2011 بكلام آخر ، اعرض الحقول في الاستعلام كما هي في الجدول ، فترى سرعة عرض الاستعلام لبياناته ، واحفظ هذا الاستعلام للرجوع اليه كمصدر لمقارنة سرعتة بالاستعلامات الاخرى ، ثم وفي نسخة اخرى منه ، ابدأ بإضافة حقل واحد (سواء حقل معادلة ، او فرز او تصفية) وابدأ بالامور السهلة ، فاذا لاحظت بطئ في الاستعلام ، فيجب معالجتها ثم الانتقال الى الحقل الآخر ، وهكذا. وكلمة اخيرة ، فالاكسس عنده امكانيات معينة ونقاط ضعف ، ولا يمكنك دائما التغلب على نقاط الضعف.

الاخوة الكرام الافاضل السلام عليكم ورحمة الله وبركاته كنت بدات في برنامج مرتبات موظفين بنظام الشيت اليومي والاخ الفاضل المعلم @kkhalifa1960 لكن ظهرت مشكلة مش عارف احلها وحاولت بس للاسف موصلتش المشكلة ان لما بعمل انتداب لفرد بعدد ايام معينة المفروض انها تسمع بقيمة الايام دي (صورة رقم 2) في اجمالي الراتب طبعا اللي في شاشة المرتبات من قائمة التشغيل صورة رقم 3 ياريت المساعدة ضروري من فضلكم نظرا لحجم البرنامج انا وضعته في اللينك التالي https://www.mediafire.com/file/1ii47pkl6x06n6g/samer-Test222.rar/file

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

تفضل https://www.youtube.com/@Emad_ghazi

يبدو اننى لم استطع صياغة السؤال بشكل مفهوم انا اقصد انه تتم عملية حسابية معقدة تستغرق مثلا من دقيقتين الى ثلاث دقائق معنى هذا انه سوف يتم استغراق نفس الوقت لعدد السجلات التى سوف يتم عرضها يعنى مثلا كل 27 او 30 سجل تحدث هذه العمليات اتستغرق ذلك الوقت ؟ ام انه من الافضل التطبيق للعمليات جميعها على كافة السجلات ليتم بعد ذلك التنقل والاستعراض دون اعادة اجراء العمليات على كل دفعة سجلات ؟؟

حلو جدا دمج فكرة الاستاذ @منتصر الانسي Option Compare Database Option Explicit ' ===== متغير عام لتفعيل الطباعة في نافذة Immediate ===== Public DebugMod As Boolean ' =============================================== ' دالة رئيسية: تقوم بعملية DLookup مع دعم المعايير المتعددة ' =============================================== Public Function GenericDLookup( _ ByVal strFieldName As String, _ ByVal strTableName As String, _ ParamArray arrCriteria() As Variant) As Variant On Error GoTo ErrHandler Dim strCriteria As String Dim lngIndex As Long Dim strField As String, strOperator As String Dim varValue As Variant Dim strOneCondition As String Dim db As DAO.Database: Set db = CurrentDb Dim tdf As DAO.TableDef: Set tdf = db.TableDefs(strTableName) ' التحقق من وجود الجدول والحقل الأساسي If Not TableExists(strTableName, db) Then Err.Raise vbObjectError + 517, , "الجدول غير موجود: " & strTableName If Not FieldExists(strFieldName, tdf) Then Err.Raise vbObjectError + 518, , "الحقل غير موجود: " & strFieldName ' التحقق من شكل المصفوفة If (UBound(arrCriteria) + 1) Mod 3 <> 0 Then Err.Raise vbObjectError + 514, , "المعايير يجب أن تكون ثلاثية" For lngIndex = 0 To UBound(arrCriteria) Step 3 strField = CStr(arrCriteria(lngIndex)) strOperator = Trim(UCase(CStr(arrCriteria(lngIndex + 1)))) varValue = arrCriteria(lngIndex + 2) If Not FieldExists(strField, tdf) Then Err.Raise vbObjectError + 519, , "الحقل غير موجود: " & strField Select Case strOperator Case "IS NULL", "IS NOT NULL" strOneCondition = "[" & strField & "] " & strOperator Case "LIKE", "=", "<>", "<", ">", "<=", ">=" strOneCondition = "[" & strField & "] " & strOperator & " " & cSQLSafe(strTableName, strField, varValue, db, tdf) Case "BETWEEN" If IsArray(varValue) And UBound(varValue) = 1 Then strOneCondition = "[" & strField & "] BETWEEN " & _ cSQLSafe(strTableName, strField, varValue(0), db, tdf) & " AND " & _ cSQLSafe(strTableName, strField, varValue(1), db, tdf) Else Err.Raise vbObjectError + 520, , "القيمة لـ BETWEEN يجب أن تكون مصفوفة من عنصرين" End If Case "IN" If IsArray(varValue) Then Dim i As Long, strIN As String For i = LBound(varValue) To UBound(varValue) strIN = strIN & IIf(Len(strIN) > 0, ", ", "") & cSQLSafe(strTableName, strField, varValue(i), db, tdf) Next strOneCondition = "[" & strField & "] IN (" & strIN & ")" Else strOneCondition = "[" & strField & "] = " & cSQLSafe(strTableName, strField, varValue, db, tdf) End If Case "EXISTS" strOneCondition = "EXISTS (" & varValue & ")" Case Else Err.Raise vbObjectError + 515, , "المعامل غير مدعوم: " & strOperator End Select If Len(strCriteria) > 0 Then strCriteria = strCriteria & " AND " strCriteria = strCriteria & strOneCondition Next If DebugMod Then Debug.Print "GenericDLookup Criteria: " & strCriteria GenericDLookup = DLookup(strFieldName, strTableName, strCriteria) Exit Function ErrHandler: If DebugMod Then Debug.Print "خطأ في GenericDLookup: " & Err.Number & " - " & Err.Description GenericDLookup = Null End Function ' =============================================== ' التحقق من وجود الجدول ' =============================================== Private Function TableExists(TableName As String, db As DAO.Database) As Boolean On Error Resume Next Dim tdf As DAO.TableDef: Set tdf = db.TableDefs(TableName) TableExists = Not tdf Is Nothing On Error GoTo 0 End Function ' =============================================== ' التحقق من وجود الحقل داخل الجدول ' =============================================== Private Function FieldExists(FieldName As String, tdf As DAO.TableDef) As Boolean On Error Resume Next Dim fld As DAO.Field: Set fld = tdf.Fields(FieldName) FieldExists = Not fld Is Nothing On Error GoTo 0 End Function ' =============================================== ' تنسيق القيمة حسب نوع الحقل لاستخدامها داخل SQL ' =============================================== Public Function cSQLSafe(strTable As String, strField As String, varValue As Variant, _ Optional db As DAO.Database = Nothing, Optional tdf As DAO.TableDef = Nothing) As String On Error GoTo HandleError If db Is Nothing Then Set db = CurrentDb If tdf Is Nothing Then Set tdf = db.TableDefs(strTable) Dim fld As DAO.Field: Set fld = tdf.Fields(strField) Dim intType As Integer: intType = fld.Type If IsNull(varValue) Then cSQLSafe = "NULL": Exit Function Select Case intType Case dbText, dbMemo, dbGUID cSQLSafe = "'" & Replace(CStr(varValue), "'", "''") & "'" Case dbDate Dim dtm As Date If TryParseAnyDate(varValue, dtm) Then cSQLSafe = "#" & Format(dtm, IIf(TimeValue(dtm) = 0, "yyyy-mm-dd", "yyyy-mm-dd hh:nn:ss")) & "#" Else cSQLSafe = "NULL" End If Case dbBoolean cSQLSafe = IIf(varValue, "-1", "0") Case dbByte, dbInteger, dbLong, dbSingle, dbDouble, dbCurrency, dbDecimal If IsNumeric(varValue) Then cSQLSafe = Replace(Format(CDbl(varValue), "0.########"), ",", ".") Else cSQLSafe = "NULL" End If Case Else cSQLSafe = "NULL" End Select Exit Function HandleError: If DebugMod Then Debug.Print "[cSQLSafe] خطأ: " & Err.Number & " - " & Err.Description cSQLSafe = "NULL" End Function ' =============================================== ' دالة تحويل أي تنسيق تاريخ إلى قيمة صالحة ' =============================================== Public Function TryParseAnyDate(ByVal strInput As Variant, ByRef dtmOut As Date) As Boolean On Error GoTo Fail If IsNull(strInput) Then GoTo Fail If IsDate(strInput) Then dtmOut = CDate(strInput): TryParseAnyDate = True: Exit Function Dim parts() As String, dd As Integer, mm As Integer, yyyy As Integer Dim timePart As String, strClean As String strClean = Trim(CStr(strInput)) If InStr(strClean, " ") > 0 Then parts = Split(strClean, " ") strClean = parts(0) If UBound(parts) > 0 Then timePart = parts(1) End If strClean = Replace(Replace(strClean, "/", "."), "-", ".") parts = Split(strClean, ".") If UBound(parts) = 2 Then dd = Val(parts(0)): mm = Val(parts(1)): yyyy = Val(parts(2)) If yyyy < 100 Then yyyy = yyyy + IIf(yyyy < 30, 2000, 1900) If mm > 12 Then Dim tmp As Integer tmp = dd dd = mm mm = tmp End If If IsDate(DateSerial(yyyy, mm, dd)) Then dtmOut = DateSerial(yyyy, mm, dd) If Len(timePart) > 0 And IsDate(timePart) Then dtmOut = dtmOut + TimeValue(timePart) TryParseAnyDate = True Exit Function End If End If Fail: TryParseAnyDate = False End Function الاستدعاء Dim varResult As Variant varResult = GenericDLookup("date2", "tbl2", _ "date2", "=", Me.text1, _ "usr_id", "=", Me.text2 _ ) If IsNull(varResult) Then MsgBox "لا توجد نتيجة" Else MsgBox varResult End If

من فضلك ما هو رابط قناة (عماد غازي رحمة ) ؟

ما رأيك بهذه الفكرة أيضاً .. On Error GoTo ErrorHandler Dim folderNames As Variant Dim folderPath As String Dim result As Long Dim i As Long folderNames = Array( _ "DDB_Control", "IMG_Company", "IMG_Company_ReP", "IMG_Wallpaper_backgreound", _ "App_IMG_Wallpaper_backgreound", "IMG_Editor_Menu", "Cantry_IMG", "fonts", _ "Icon_Button", "Icon_Msgbox", "Sound", "Wallpaper", "Video", "db_BE", _ "ExE", "IMG_Report", "File_word", "File_Excel", "Book", "File_PowerPoint", _ "File_Text", "File_Code", "All_InFile_One_Zip_Rar", "ICOn", "Icon_bar_DB", _ "Icon_bar_Form_Report", "Icon_Button", "icon_Gif", "Icon_Msgbox", _ "LinkedDB_Backups", "Office_Video", "Qr", "QR_User", "Resources", _ "World_Cantry", "Gif_IMG", "Fix_Photo", "db_db_db_test_link", _ "Corrupted_DBs", "Corrupted_Archives", "Change_Dy_Time_All_Table", _ "Add Fonts.bmp" _ ) For i = LBound(folderNames) To UBound(folderNames) folderPath = Application.CurrentProject.Path & "\" & folderNames(i) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً! " & folderPath Me.lblStatus.ForeColor = vbRed End If DoEvents Next i Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & Err.Description Me.lblStatus.ForeColor = vbRed

الاستاذة @منتصر الانسي و @hanan_ms تم عمل موضوع خاص لمشاركاتكم

بالعكس ، فانت تقوم بجعل البرنامج بطئ بدون سبب !! بما ان الاكسس يقوم بما عليه وبكل اريحية ، فلماذا تغير الوضع ؟ نعم تستطيع عمل هذا بالكود ، بتحميل بيانات الاستعلام التي تم معالجتها دفعة واحدة ، ولكنك ستدفع ثمن التأخير : dim rst as dao.recordset set rst=currentdb.openrecordset("Select * From Query1") rst.movelast rst.movefirst او في النموذج المستمر ، عند تحميل النموذج: docmd.gotorecord,,aclast docmd.gotorecord,,acfirst

ولا يهمك أخي الفاضل .. استكمل باقي المطلوب بشكل واضح ، وإن شاء الله تجد مطلبك ..

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

استاذي الفاضل Foksh كلمة شكرا قليلة في حقك ممنون من حضرتك يا طيب نسأل الله جل شأنه ان يمن عليك بالصحة والعافية والخير والبركات تمام 100 % ما نستغنى عن حضرتك يا طيب

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

جزاكم الله خيـــــــــرا استاذى والان تعلمت شئ جديد وتم تصحيح معلومة مغلوطة لدى

انت تأكد كلامي ولكن بعدد سجلات مختلف (قد يعتمد على العدد الذي تم عرضه) ، فلو ان الاكسس "كان يعالج باقي السجلات تدريجيا فقط في الخلفية" ، لحصلت على العدد 100 ، وهو عدد سجلات الكامل في الجدول.

النسخة اللي عندي 2019 انجليزية = 64 بت

الصراحة أن هذه المشكلة مثل المخدر الذي لا يستطيع الشخص الإقلاع عنا إلا بحلها وكلما قلت سأقلع عن التفكير فيها أرجع لها وبقوة توصلت أخيرا لدالة تحويل تشية دوال التحويل المضمنة (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